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C0PYHI3HT  (C)  1978  i^LGEMTS  OF  THtl  UNIVERSITY  OF  CALIFORNIA. 
P^lRMISSION  TO  COPY  OR  DISTRI^^UTE  THIS  SOFTWARE  OR  DOCUMEN- 
TATIOinI  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  3Y  WRITTEN  LICENSE 
OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS, 


♦  ) 
*) 
*) 
*) 
*) 
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PROGRAM  ^ASCALSYSTEM; 

*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 

♦  ) 
*) 
*) 
*) 

♦  ) 
*) 


UCSD  PASCAL  OPERATING  SYSTEM 

RELEASE  LEVEL:   1,3  AUGUSTt  1977 

1.4  JANUARY,  1978 

1.5  SEPTEMBER,  1978 
II. 0  FEBRUARY,  1978  BD 

WRITTEN  BY  ROGER  T.  SUMNER 
WINTER  1977 

INSTITUTE  FOR  INFORMATION  SYSTEMS 
UC  SAN  DIEGO,  LA  JOLLA,  CA 

KENNETH  L.  BOWLES,  DIRECTOR 


CONST 


MMAXINT  =  32767;  (♦MAXI 

MAXJNIT  =  12;  (*MAXI 

MAXDIR  =  77;  (*MAX 

VIDlENG  =  7;  {*NUMB 

TIDleNG  =  15;  (*NUMB 

MAXSEG  =  15;  <*MAX 

FBLksIZE  =  512;  (*STAN 

DIR3LK  =  2;  <*DISK 

AGElIMIT  =  300;  (*MAX 

EOL  =  13;  (*END 

DLE  =  16;  (*BLAN 


MUM  INTEGER  VALUE*) 

MUM  PHYSICAL  UNIT  U    FOR  UREAD*) 

NUMBER  OF  ENTRIES  IN  A  DIRECTORY*) 

ER  OF  CHARS  IN  A  VOLUME  ID*) 

ER  OF  CHARS  IN  TITLE  ID*) 

CODE  SEGMENT  NUMBER*) 

DARO  DISK  BLOCK  LENGTH*) 

AODR  OF  DIRECTORY*) 
AGE  FOR  GDIRP..,IN  TICKS*) 
OF-LINE.. .ASCII  CR*) 
K  COMPRESSION  CODE*) 
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TYPE 


NA^-:_LEri  =  23:      CLEI^GTH  OF  CO^JCAT  (  VIDLEN5  »  •  :  •  .  TIDLENG  )  H 
FILl.LE;j  =    11;      C"^AXIMUM  fj  OF  NULLS  IN  FILLER] 


lORSLTWj  =  (INOEKHORiIBADBLOCKtlBADUNITtlBADMODE.lTIMEOUTt 
ILOSTUNlT.ILOSTFILEiIBADTlTLE.lNOROOMflNOUNIT, 
INOFILE,IDUPFILE,INOTCLOSED,INOTOPEN,IBADFOR;>1AT, 
ISTRGOVFL) ; 

(*COMMAND  STATES. ..SEE  6ETCMD*) 

CMDSTATE  =  ( HALTINIT , DEBUGCALL , 

UPROGNOU.UPROGUOKtSYSPROG. 
COMPONLY,COMPAMDGO,COMPDEBUGf 
LiNKANDGOtLlNKDEBUG) ; 

(*CODE  FILES  USED  IN  GETCMD*) 

SYSriLE  =  {ASSMBLER, COMPlLERtEDITOR, FILER, LINKER) ; 

(♦ARCHIVAL  INFO. ..THE  DATE*) 

DATerEC  =  PACKED  RECORD 

month:  0..12;  (*0  IMPLIES  DATE  NOT  MEANINGFUL*) 

DAY:  0.,31;  (♦DAY  OF  MONTH*) 

year:  0..100         (*ioo  is  temp  disk  flag*) 


END  (*DATEREC*) 


UNITNUM  r  0  .  .  k^AXUNIT  ; 
VID  =  STRINGCVIDLENG]; 


DIRRANGE  =  O..MAXDIRJ 
TIO  =  STRINGCTIDLENGD5 
FULl>ID  =  STRINGCNAME-LEN3; 


(♦VOLUME  TABLES*) 


(*DISK  DIRECTORIES*) 


FILE.TABLE  =  ARRAY  CSYSFILEJ  OF  FULL_IO; 

FILEKIND  =  (UNTYPEDFILE.r  ^KFILE , CODEFILE , TEXTFILE , 
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IMFljFILl,DATAFIlE,GRAFFILE,FOTOFIL£,SECUREDIR)  ; 


direntry  =  packlu  record 

OFlRSTbLK;  INTEGER; 
OLASTBLK:  INTEGER; 
CASE  DFKIND:  FILEKIND 

iECUREDIR, 

UNTYPEDFILE:  (*OfNJLY  IN 
(FILLERl  :  0. ,20(48; 

dvid:  \/I3; 

DEOVBlK:  INTEGER; 


(*FIRST  PHYSICAL  DISK  ADDR*) 
(•POINTS  AT  BLOCK  FOLLOWING*) 
OF 


DIRCOD.. .VOLUME  INFO*) 

CFOR  DOWNi^ARD  COMPATIBILITY ,  13  BITSD 

(*NAME  OF  DISK  VOLUME*) 

(♦LASTBLK  OF  VOLUME*) 


DNUHFILES:  DIRRANGE;     (*NUM  FILES  IN  DIR*) 

dloadtime:  integer;     (*time  of  last  access*) 

DLASTBOOT:  DATEREC);     (*M0ST  RECENT  DATE  SETTING*) 

xdskfile.codefile,textfile»infofile, 
datafile.graffile.fotofile: 


END 


(FILLER2  :  0,.102h;  CFOR 
status  :  BOOLEAN; 

dtid:  tid; 

dlastbyte:  l.fblksize; 

daccess:  daterec) 

(*DirentRY*)  ; 


DOWNWARD  COMPATIBILITYD 

CFOR  FILER  WILDCARDS^ 
{*TITLE  OF  FILE*) 
(*NUM  BYTES  IN  LAST  BLOCK*) 
(*LAST  MODIFICATION  DATE*) 


DIRP  =  '^DIRECTORY; 

DIRECTORY  =  ARRAY  CDIRRANGEJ  OF  DIRENTRY; 

(*FILE  INFORMATION*) 
CLOSETYPE  =  (CN0R«IAL, CLOCK, CPURGEiCCRUNCH); 

wiNoowp  =  '^window; 

WINDOW  =  packed  array  co,.o:  of  char; 

FiBp  =  '^fiB; 

FI3  =  RECORD 

FWINDOW:  WINDOWP;   (*USER  WINDOW ,.  .F-^,  USED  BY  GET-PUT*) 

feof.feoln:  boolean;  ' 

fstate:  (fjandwtfneedchartfgotchar) ; 

FRECSIZE;  integer;  (tl-g  BYTES. ..0  =  >BLOCKFILE,  1  =  >CHARFILE* ) 
CASE  FISOPEN:  boolean  of  ^unMKMLL*) 

TRUE:  (FISBLKD:  BOOLEAN;  (*FILE  IS  ON  BLOCK  DEVICE*) 
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EWD  (*FIS*) 


fuwit:  unitnum;   (*physical  unit  #*) 
f-viD:  vid;       (♦volume  name*) 

FREPTCNT.  (*  U    TIMES  F'^  VALID  W/0  GET*) 

FNXTBLK,  (*NEXT  REL  BLOCK  TO  10*) 

FMAXBLK:  integer;  (*MAX  REL  BLOCK  ACCESSED*) 
FM0DIFIED:300LEAN5 (*PLEASE  SET  NEW  DATE  IN  CLOSE*) 

fheader:  direntry; (*copy  of  disk  dir  entry*) 
CASE  fsoftbuf:  boolean  of  (*disk  get-put  stuff*) 

true:  (FrJXT3YTE,FMAXBYTE:  INTEGER; 
F3UFCHNGD:  BOOLEAN; 
FBUFFER:  PACKED  ARRAY  CO , .FBLKSIZED  OF  CHAR)) 


(♦USER  WORKFILE  STUFF*) 


inforec  =  record 

symfibp,codefi3p:  fibp; 
errsvm.errblk.errnum:  integer; 

SLOWTERM, stupid:  BOOLEAN; 

altmode:  char; 
gotsym,gotcode:  boolean; 

W0RKVlD,SYMVIDtC0DEVID:  VID; 

worktid,symtid,cgdetid:  tid 
end  (*inf0rec*)  ; 


(*W0RKFILES  FOR  SCRATCH*) 
(*ERROR  STUFF  IN  EDIT*) 
(*STUDENT  PROGRAMMER  ID!!*) 
(♦WASHOUT  CHAR  FOR  COMPILER*) 
(*TITLES  ARE  MEANINGFUL*) 
(*PERMSCUR  WORKFILE  VOLUMES*) 
(♦PERMSCUR  WORKFILES  TITLE*) 


(*CODE  SEGMENT  LAYOUTS*) 


SEGRAfJGE    =    O..MAXSEG; 
SEGdeSC    =    RECORD 

diskaodr:  integer; 

CODELENG:  INTEGER 
END  (*SLGDESC*)  ; 


(*REL  BLK  IN  CODE...ABS 
(*«  BYTES  TO  READ  IN*) 


(*DE8UGGER  STUFF*) 


IN  SYSCOM'**) 


BYTCRANGE  =  0..25b; 

TRICKARRAY  =  RECORD         CMEMORY  DIDDLING  FOR  EXECERROR^ 

CASE  BOOLEAN  OF 

TRUE  :  (WORD  :  ARRAY  CO,. 03  OF  INTEGER); 
FALSE  :  (BYTE  :  PACKED  ARRAY  CO. .03  OF  BYTERANGE) 
ENU; 
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.^SC;.  =  RECORD 

STATLINK:  MSCi^P;    (*POIf^JTER 

DYf^JLirjK:   Mscwp;        {♦poimter 

f^SSEG.MSJTAa:  '^TRICKARRAY; 

MSiPC:  integer; 
localdata:  trickarray 
etjc  (*mscw*)  ; 


(♦MARK  STACK  RECORD  POINTER*) 


TO  PARENT  MSCW*) 
TO  CALLER'S  MSCW*) 


SYSCQMREC  =  RECORO 

lORSLT:  lORSLTWD; 
XEQERR:  INTEGER; 
sysunit:  UNITMUM; 
3UGSTATE:  INTEGER; 
GOIKP:  DIRP; 
LASTMPtSTKBASEfBOMBP: 


(*SYSTEM  COMMUNICATION  AREA*) 
(*SEE  INTERPRETERS. ..NOTE  ♦) 
(*THAT  WE  ASSUME  BACKWARD  *) 
(♦FIELD  ALLOCATION  IS  DONE  *) 

(♦RESULT  OF  LAST  10  CALL*) 
(♦REASON  FOR  EXECERROR  CALL*) 
(♦PHYSICAL  UNIT  OF  BOOTLOAD*) 
(♦DEBUGGER  INFO*) 
(*GLOBAL  DIR  POINTER^SEE  VOLSEARCH*) 

MSCWp; 


INTEGER; 

(♦WHERE  XEQERR  BLOWUP  WAS*) 
(♦MORE  DEBUGGER  STUFF*) 
OF  INTEGER; 

(♦DRIVERS  PUT  RETRY  COUNTS^) 
>ai    OF  INTEGER; 


,33 


MEMTOP,SEG, JTAB: 
BOMBIPC:  INTEGER; 
HLTLINE;  INTEGER; 
BRKPTS:  ARRAY  CO, 
retries:  INTEGER; 

expansion:  array  co 
hightime,lowtime:  integer; 
miscinfo:  packed  record 

n03reak*stupid,sl0wtermt 

HASXYCRT,HASLCCRT,HAS8510A,HASCLOCK:  BOOLEAN; 
USERKIND: (NORMAL*  AQUIZ*  BOOKER.  POUIZ); 
IS.FLIPT  :  BOOLEAN 

END; 
CRTTYPe:  INTEGER; 

crtctrl:  packed  record 

RLF,NDFS.ERASEEOL,ERASEEOS, HOME, ESCAPE:  CHAR; 

backspace:  char; 
fillcount:  0..255; 
cleapscreen.  clearline:  char; 

prefixed:  packed  array  Z0,,B1    of  BOOLEAN 

end; 
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\/AR 


CRTlf^FO:  PACKED  RECORD 

WIDTH, height:  INTEGER; 

right, left, down,up:  char; 

baoch,chardel, stop, break t flush, eof;  char; 

altmode,lineoel:  char; 

BACKSPACE, ETX, prefix:  CHAR; 

prefixed:  PACKED  ARRAY  CO. .13]  OF  BOOLEAN 

EMD; 
SEGTABLE:  ARRAY  CSEGRANGE]  OF 
RECORD 

codeunit:  unitnum; 
codeoesc:  segdesc 

END 
END  (*SYSCOM*); 


MISCINFOREC 


=  RECORD 

msyscom: 
end; 


SYSCOMREC 


syscom:  '"syscomrec; 
gfiles:  array  co. .53  of  fibp; 
userinfo:  inforec; 
emptyheap:  ^integer; 
inputfib,outputfib» 

SYSTERM,Sifl/APFIB:    FIBP; 

syvid.dkvid:  vid; 
thedate::  daterec; 
debuginfo:  '^integer: 

STATE:    CiViDSTATE; 

pl:  string; 

ipot:  array  co. .43  of  integer; 

filler:  stringcfill.lend; 

digits:  set  of  •o'..'9' ; 

unitable:  array  cunitnumd  of  (*o  not  used*) 

RECORD 

UVID:  VID;     (*VOLUME  ID 
CASE  UISBLKD:  BOOLEAN  OF 

true:  (ueovslk:  integer) 
end  (*unitable*)  ; 
filename  :  file_table; 


{♦MAGIC  PARAM,..SET  UP  IN  BOOT*) 
(*GL0BAL  FILESt  0=INPUT»  1=0UTPUT*) 
(*W0RK  stuff  for  COMPILER  ETC*) 
(♦HEAP  MARK  FOR  MEM  MANAGING*) 
(♦CONSOLE  FILES. ..GFILES  ARE  COPIES*) 
(♦CONTROL  AND  SWAPSPACE  FILES*) 
(*SYSUNIT  VOLID  &    DEFAULT  VOLID*) 
(*TODAY.,.SET  IN  FILER  OR  SIGN  ON*) 
(♦DEBUGGERS  GLOBAL  INFO  WHILE  RUNIN*) 
(*FOR  GETCOMMAND*) 

(*PROMPTLINE  STRING. ..SEE  PROMPT*) 
(*INTEGER  POWERS  OF  TEN*) 
(♦NULLS  FOR  CARRIAGE  DELAY*) 


FOR  UNIT*) 
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264 

2b4 

264  (*  SYSTE'4  PROCEDURE  FQKWARD  DECLARATIONS  *) 

264  (*  THESE  ARE  ADDRESSED  BY  OBJECT  CODE...  *) 

2o4  (*  DO  Mot  ^ove  without  carefjl  thought  *) 

264 

1  PROCEDURE  EXECERROR; 

1  FORWARD; 

1  PROCEDURE  Flf'JlTCVAR  f:  FIb;  WINDOw:  WINDOWP;  RECwORDS:  INTEGER); 

4  FORWARD; 

1  PROCEDURE  FRESET(VAR  F:  FIB); 

2  FORftiARj; 

1  PROCEDURE  fopen(var  f:  fib;  var  ftitle:  string; 

5  fopenold:  BOOLEAN;  junk:  fibp); 

5    FORWARD 

1  PROCEDURE  FCLOSE(VAR  f:  FIB;  ftype:  CLOSETYPE); 

5    FORWARD 

1  PROCEDURE 

2  FORWARD 

1  PROCEDURE 

2  FORWARD 
1  PROCEDURE 
1    FORWARD 

3  FUNCTION 
'+    FORWARD 

3  FUNCTION  I 

4  FORWARD 
1  PROCEDURE 

3  FORWARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 
1  FORWARD 
1  PROCEDURE 
1  FORWARD 
1  PROCEDURE 

3  FORWARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 
4    FORWARD 


■*) 


FGlT(VAR  F;  FIB) ; 
FPUT(VAR  F:  FIB) ; 

xseek: 

■EOF(VAR    F:    FIB):    BOOLEAN; 
■EOLN(VAR    F:    FIB):    BOOLEAN; 
FREADINTCVaR    F:    FIB;     VAR    l:    INTEGER); 
FWRITEINT(VAR    F:    Fl3;     I,RLEN6:     INTEGER); 
XReADREAL; 

xwritercal; 

freadchar(vak  f:  fib;  uar  ch:  char); 

FWRITECHAR(VAR  f:  FIB;  CH:  CHAR;  RLENG:  INTEGER); 

freadstring(Var  f:  fib;  var  s:  string;  sleng:  integer); 
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I    P«OCEDU^£  FWRITrsTRl[jC-(VAR  F:  FI3;  VAR  S;  STRING;  RLENG:  IMTE&ER); 
1    f-  U  K  W  A  '^  3 ; 

1  PROCEDURr  FWRITEBYTEs  ( VAR  F:  FI3;  VAR  A:  wINDOl^;  RLENG, ALENG:  INTEGER); 
J    FORWARD ; 

1  PROCEDURE  FReaDL^JCVAR  F:  FIB); 

2  FORWARD; 

1  procldure  fwriteln(var  f:  fib); 

2  FORWARD; 

1  PROCEDURE  SCONCAT{VAR  DEST.SRc:  STRING!  DESTLENG;  INTEGER); 
1    FORWAR^J; 

1  PROCEDURE  SINSERT(VAR  SRCOEST:  STRING;  DESTLENG, INSINX;  INTEGER); 

0  FORWARD;  <»-wi_i   , 

1  PROCEDURE  SCOPYCVAR  SRCDEST:  STRING;  SRCINX , COPYLENG:  INTEGER); 

1  PROCEDURE  SDELETE(VAR  DEST:  STRING;  DELINX tDELLELNG:  INTEGER); 
f    FORWARD; 

3  FUNCTION  SPOS(VAR  TARGET, SRC:  STRING):  INTEGER; 
5    FORWARD; 

3  FUNCTION  FBLOCKIQ(VAR  F:  FiB;  VAR  A:  WINDOW;  i:  INTEGER; 

t      c^„,,  ,        nblocks,rblock:  integer;  doread:  boolean):  integer; 

9  FORWARD; 

1  PROCEDURE  FG0T0XY(X,y:  INTEGER); 

3  FORWARD; 

3 

3  (*  NON  FIXED  FORWARD  DECLARATIONS  *) 
3 

3  FUNCTION  \/OLSEARCH(VAR  FVID:  VID;  LOOKHARD:  BOOLEAN; 

5  VAR  FDIR:  DIRP):  UNITNUM; 

6  FORWARD; 

1  PROCEDURE  WRiTEDIR(FUNIT:  UNITNUM;  FDIR:  DIRP); 
3    FORWARD; 

?  ^"^cnl.^.^o  DIRSEARCH(VAR  FTIQ;  TID;  FINDPERM:  BOOLEAN;  FDIR:  DIRP):  DIRRANGE; 

0  r  UKW AKQ ; 

3  FUNCTION  SCANTITLE(FTITLE:  STRING;  VAR  FVID:  VID;  VAR  FTID:  TID; 

°  \/AR  FSEGS:  IMTEGER;  VAR  FKIND:  FILEKIND):  BOOLEAN; 

■+7    h  UKWAKQ  ; 

1  PROCEDURE  DELENTRYtFiNX:  DIRRANGE;  FDIR:  DIRP); 
3    FORWARD; 

1  Pf^JCEDURE  INSENTRY(VAR  FENTRY:  DIRENTRY;  FINX:  DIRRANGE;  FDIR:  DIRP); 

1         tORwaRD; 

1    PROCEDURE    HO.MECURSOR; 
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clearscreen; 
clearline; 

PROMPT; 

spacewait(fliish:  boolean):  boolean; 
etchar(Fljsh:  boolean):  char; 

FETCHDIR(FUNlT:urjITNUM)     :    BOOLEAN; 

coimmand; 


C$1    GLOBaLS    3 

C$1  syssegs.a  1 

«*  *) 

(*  COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.  *) 

(*  PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-  *) 

(*  TATION  in  hard  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE  ♦) 

(*  OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS,  *) 

!*  *» 

SEGMENT  PROCEDURE  USERPROGRAM { INPUT, OUTPUT:  FIBP); 
BEGIN  FWRITELNCSYSTERM'^); 

PL  :=  t^io  USER  PROGRAM'  ; 

FWRlTESTRlNG(SYSTERM'*fPLtO) 
END  (*USERPROGRAM*)  ; 

SEGMENT  PROCEDURE  DEBUGGER; 
BEGIN  FWRITELNCSYSTERW") ; 

PL  :=  'NO  DEBUGGER  IN  SYSTEM*; 

FWRITESTRING(SYSTERM''.PL,0) 
END  (♦DEBUGGER*)  ; 
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lo:   S  :=  'PRiJGRA^;^it:D  3KLAK-°DI;iT  • 
EJJ'J  (*xEa  ERRORS*)  ; 
WRITeLn(OUTPUT,S) ; 
END  (*PRlig  TERROR*)  ; 

SEG^EfvlT  PROCEDURE  INITIALIZE? 

VAR  JUST300TED:  BOOLEAiJ;  LTlTLE:  STRINGC40J; 
T'^OntHS:  ARRAY  CO.. 15:  OF  STRINGCSD; 
STARTUP  :  BOOLEAN; 
STkFILL:  ARRAY  C0..1199J  OF  INTEGER; 

PROCEDURE  INITSYSCOM; 

VAR  title:  strl'mg; 

f:  file  of  miscinfqrec; 

PROCEDURE  IMIT.FILLER(VAR   FILLER  :  STRING); 
3EGIN 

h'lTH    SYSCOW^.CRTCTRL    DO 
BEGIN 

IF    FILLCOUNT    >    FiLL.LEr     THEN 

fillcount   :=  fill.leTv; 

FILLERCO:  :=  CHR(FILLCCJNT) ; 

FI LLCHAR(FILLERC13.FILL COUNT, CHR(O)) ; 

end; 

END   COF  INIT. filler:; 

SE;Gli\i  COF    INITSYSCOMD 

INiT-FILLER(FILLER) ; 

DEsuGiNFO  :=  nil; 

iPOTCo:  :=  1;  ipoTCiD  :=  id;  ipctc2D  :=  loo; 

IP0TE3]  :=  1000;  iP0TC4a  :=  loooo;  digits  :=  C'0'..»9'd; 

with  SYSCOM'^  do 
3EGIN 
XEQERR  :=  0;     lORSLT  :=  inoerrqr; 

3UGSTATE  :=0 

end; 

TITLE  :=  ••SYSTEM. MISCINFO'  ; 

reseT(   f,   title   »i 

IF  ioresult  =  orli(inoerror)   then 

3EGIN 

IF    NOT    EOF(    F    •>     THEN 
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F-    DO 


:=    MSYSCU^.MISCIfNiFO; 

;=  msyscom.ckttype; 
;=  msyscom.crtcti^l; 
;=  msyscom.crtimfo; 

INIT_FILLEK(FILlER) ; 

end; 
close(  f,  normal  ) 

ENOt 
UNITCLEAR(I)  (*GIVE  BIOS  NEw  SOFT  CHARACTERS  FOR  CONSOLE*) 
END  <*INITSYSCO,M*)  ; 

PROCEDURE  INITUNITABLE; 

VAR  lunit:  unitnum; 
loir:  dirp; 

LFIB  :  FIB; 

F  :  sysfile; 

TE^IP-NAMES  :  FILE. TABLE; 
NOt.FOUND  :  SET  UF  SYSFILE; 

procedure  INIT_ENTRY{LUNIT  :  UNITNUM;  UNIT-NAME  :  VID); 
BEGIN 

UNITCLEAR(LUNIT) 5 

IF  lORESULT  =  ORD(INOERROR)  THEN 
UNITABLECLUNIT3.UVID  :=  UNIT-NAME; 

END  coF  init,entryd; 

begin       cof  initunitablej 
file^jamecassmbler:l  :=  ':  system,  assmbler  '  ; 
filEna^eccompilerd  :=  • :system, compiler* ; 
filenameceditorj  :=  • :system, editor* ; 
file^jamecfilerj  :=  •  isystem. filer*  ; 
fileijameclinker]  :=  »  :system, linker*  ; 
temp„names  :=  filename; 

NOT-FOUND  :=  CASSMtiLER  ..  LINKER3; 
FINlT(LFIBtNIL.-l); 
FOR  LUNIT  :=  0  TO  MAXUNIT  DO 
WITH  UNITABLECLUNIT3  DO 

IIEGIN 

uviD  :=  •*; 
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JlSBLKu  :=  LUNIT  IN  C4,S,9..12D; 
IF  UISELKD  THE(\i 

u£:gi:j 
ueovblk  :=  mmaxint; 
unitclearclunit) ; 

IF    lORESULT    =    ORD(IfjOERROR)    THEN 

IF  fetchdir(lunit)  then 

BEGIN 

uviD  :=  syscoiV!'^.gdirp'^co:.dvid; 

IF  LUNIT  =  SYSCOW^.SYSUNIT  THEN 
BEGIN 

SYVID  :=  UVID; 

LTITLE  :=  •*SYSTEM. STARTUP* ! 

FOPEN(LFIBiLTITLEiTRUEiNlL); 

STARTUP  :=  LFIB.FISOPEN? 

FCL0SE(LFI3,CN0RMAL) ; 

END; 
FOR  F  :=  ASSMBLER  TO  LINKER  DO 

IF  (LUNIT  =  SYSCOM'-.SYSUNIT)  OR  (F  IN  NOT_FOUND)  THEN 

BEGIN 

LTITLE  :=  C0NCAT(UVID.TEMP_NAMESCF3) 5 
FOPEN (LF IB. LTITLE f TRUE, NIL ){ 
IF  LFIB.FISOPEN  THEN 
BEGIN 

FILEMAFECFD  :=  LTITLE; 
NOT>FOUND  :r  NOT-FOUND  -  CF3; 
END; 
FCLOSE(LFIB,CNORMAL) ; 
END  EOF  IF  (LUNIT  ,,,1; 
END  COF  IF  FETCHDIR  ,.     1    \ 
END   COF  IF  UISBLKD  ..  2; 
END  COF  WITH3! 
IF  JUSTBOOTED  THEN 
DKviD  :=  SYVID; 

lunit  :=  v0lsearch(syvid. false, ldir) ; 
if  ldir  =  nil  then 
halt; 

THEDatE    :=    LDIR'^COJ.DLASTBOOT; 
INIT_CNTRY(1. 'CONSOLE') ; 
INIT_ENTRY(2»'SYSTERM») ; 
INI T, ENTRY (3, 'GRAPHIC ) ; 
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41 
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66 
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6:6 
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6:7 

66 
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77 
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93 
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116 

577 

4 
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116 

INlT_rNTrHY{b.  'PRINTER'  )  \ 
lrJlT_rf\|TRY(7,  'RENIN'  )  ; 
lMT_Li\iTKY(S.  'REMOUT'  )  ; 
END    COF    INITUiMlTABLED; 

PHOCEOlJRE    INITCHARSET; 

TYPE    Ch|ARSET=    ARRftY    Ii2,.l272    OF 

PACKED  ARRAY  CO, .93  OF  0..255; 

VAR  i:  integer; 

DOTRITON  :  BOOLEAN; 

TRIX:  RECORD  CASE  BOOLEAN  OF 

TRUE:  (charaddr:  integer); 

FALSE:  (CHARBUFp:  '^  CHAR) 

end; 

display:  array  CO., 79,0. .193  of  integer;  (*F0R  TRITON*) 

charbuf:  record 

SETi:  charset; 

FiLLERi:  packed  ARRAY  CO. .63:  OF  CHAR; 
SET2:  CHARSET; 

FILLER2:  PACKED  ARRAY  CO. .633  OF  CHAR; 
TRITON:  ARRAY  C0..63t0..33  OF  INTEGER 

END  (*CHARBUF*)  ; 

LFie:  fib; 

BEGIN  FlNIT(LFIBtNIL»-l) ; 

LTITLE  :=  •♦SYSTEM. CHARSET'; 
FOPEN{LFIB.LTITLEt TRUE* NIL) ; 

IF  lfib.fisopen  then 

BEGIN 

UNITCLEAR(3); 

IF  lORESULT  =  ORDdNOERROR)  THEN 
BEGIN 

UNITWRITE(3»TRIX»123) ; 
WITH  LFIB.FHEADER  DO 
BEGIN 

DOTRITON  :=  DLASTBLK-DFIRST3LK  >  4; 

UN I TRE AD ( LF IB, FUNIT, CHARBUF, SI ZE0F( CHARBUF) .DFIRSTBLK) 

end; 
trix.charaudr  :=  512-8192;  (*unibus  trickyness ! * ) 
for  i  :=  32  to  127  do 

BEGIN 

^OVERlGHT(CHA|-   'F  .  SETlC  n  ,  TRIX  .CHARBUFP'^ .  10  )  ; 
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7:i 

0 

605 

4 
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7:i 

33 
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41 

609 
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52 
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7:i 

71 
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7:i 

79 

613 

4 

7:i 
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114 
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4 

7:2 

126 

618 

4 
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TRIX.CHARADDR     :=    T'UX  ,  CHARADuR  +  l& 

£f\iD; 

TRIX.CHARADDR  :=  512-6144; 
FOR  I  :=  32  TO  127  DO 

BEGIN 

mover:ght(Charbuf.se:t2Cid,trix.charbufp''»io)  ; 

trix.charaddr  :=  trix .  charaddr-h6 
end; 
if  justbooted  and  dotriton  and  not  startup  then 
begin  (*initialize  display  array*) 

fillchar( display, sizeof{ display) to) ! 

for  i  :=  0  to  63  do 

MOVELEFT(CHAR3UF.TRITQNCn,DlSpLAY[:i»10D,8)  ; 
UNITWRITE(3,DISPLAY[:-B0:,23) 
END   ELSE 

UNITWRITE(3, DISPLAY, 7) ; 
END 
END 
ELSE 

SYSCOM*,MISCINFO.HAS8510A  !=  FALSE; 
FCLOsE(LFIB,CNORmAL) 
END  (*INITCHARSET*)  ; 

PROCEDURE  INITHEAP; 

VAR  LWINDOW:  WIND0WP5 

BEGIN  (*BASIC  FILE  AND  HEAP  SETTUP*) 

SYSCOM^.GDIRP  :=  NIL;  {*  MUST  PRECEDE  THE  FIRST  "NEW"  EXECUTED  *) 

NEW (SWAPFIB, TRUE, FALSE) ;  FINIT ( SWAPFIB" »NIL. -1 ) ; 

NEW(INPUTFIB,TRUEtFALSE) ;   NEW ( LWINDOW ) ; 

FiNlTdNPUTFIB'*, LWINDOW, 0)  ; 

NEW(0UTPUTFI3»TRUEiFALSE)  ;   ^JEW  (LWINDOW  )  ; 

FINIT(0UTPUTFIB'^, LWINDOW, 0)  5 

NEW(SYSTERM, TRUE, FALSE) ;   NEW ( LWINDOW ) ; 

FINIT(SYSTERM'^, LWINDOW, 0)  ; 

SFiLEsco:  :=  inputfib;  gfilescid  :=  outputfib; 

WITH  USERINFO  DO 
BEGIN 

NEW  (SYMF  IBP,  TRUE,  FALSE)  !  FINIT<  SYMFIBP'^tNlL, -1 )  ; 
NEi^(CODEFIBP,TRUEtFALSE)  ;  FINIT{  C0DEFIBP'^,NIL» -1 ) 
ENO;  ^^ 

^ARK{EMPTYHEAP)  XD 
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9:3 

75 

638 

4 

9:3 

31 

639 

4 

9:2 

33 

640 

4 

9:1 

87 

641 

4 

9:0 

92 

642 

4 
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174 

tND  (*i:-jIThe:ap*)  ; 

PROCEQjRE  KJITa'OF^KFILE; 

PROCIOJRE  TRY_OPEr-i(VAR  u»IORK_PIB  :  FIB;  FIRST  :  FULL. ID;  VAR  SEC_VOL  :  VXD; 

VAR  SEC-MAME  :  TID;  VAR  FLAG  :  BOOLEAN); 
VAR   LTITLE  :  F'JLL-IO; 
BEGig 

F03EN(W0RK_FI3. FIRST* TRUE. NIL) ; 
IF  NOT  W0RK_FIB.FIS0PEN  THEN 
IF  SEC-NAME  <>  "  THEN 
BEGIN 

LTITLE  :=  CONCAT(SEC_VOL.  •:SSEC_NAME)  ; 

fopen ( work-f ib. ltitle, true  1  nil) ; 
end; 
FLAG  :=  work_fib.fisopen; 

IF  FLAG  THEN 
3EGIN 

SEC. VOL  :=  WORK. FIB. fvid; 

sec-name  ;=  work-fib. fheader.dtid 

end; 

FClOSE(WORK-FIB»CNORMAL) ; 
end;   COF  TRY.0PEN3 

BEGIN 

WITH  USERINFO  DO 

BEGIN  (*INITIALI^E  WORK  FILES  ETC*) 

ERRNUM  :=  0;  ERRBLK  :=  0;  ERRSYM  :=  0; 
IF  JJSTBOOTED  THEN 
3EGIN 

SYMTID  :=  ••;  coDETio  :=  ••;  worktid  :=  «»; 

SYMVID  :=  syvid;  codevid  :=  syvid;  workvid  :=  syvid 

ENO; 
TRY-OPENCSYMFIBP'^,  •♦SYSTEM. WRK. TEXT'  .SYMVID.SYMTID.GOTSYM)  ; 
TRY_OPEN(COOEFiaP'^.«*SYSTEM.WRK. code ». codevid, CODET ID. GOTCODE)  ; 

altmode  :=  syscom^.crtinfo.altmode; 
slowterm  :=  syscom'',miscinfo,slowterm; 
stupid  :=  SYscoM'^.MisciMFO. stupid; 

END 

end  {♦initworkfile*}  ; 
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1 
0 
0 
7 
14 
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35 
50 
60 
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73 
88 
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85 
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250 
256 


PROCEDURE  lijITFILES; 
3EGIN 

fclose(swapfis'',cnormaL)  ; 

FCLOSE(USERIMFO.SYMFIBP'^.CNORMAL)  ; 
FCLOSE(USERIWFO.CCOEFIBP'^,CNOR'^AL)  ; 
FCLOSEdNPJTFIB^.CNORMAL)  ; 
FCLOSE(OUTPUTFIB'*,Cl\)ORMAL)  ; 

LTiTLE  :=  'console:*; 

FOPEMdNPUTFIS'^tLTITLEt  TRUE.  NIL)  ; 
FOPEncOUTPUTFIB'^.LTITLE,  TRUE,  NIL); 
IF  JUSTBOOTED  THEN 

BEGIN  LTITLE  :=  'SYSTER^:'; 

F0PEN(SYSTERM'"»  LTITLE,  TRUE,  NIL) 
END; 
GFILEsCOl  :=  INPUTFIB; 

GFiLESCi:  :=  outputfib; 

GFILESC2D  :=  SYSTERM; 
GFILESC3D  :=  NIL;  GFILESC43  :=  NIL; 
END  (*INITFILES*)  ; 


GFILESC53  :=  NIL; 


BEGIN 
JUS 
MON 
WON 
MON 
MON 
MON 
MON 
MON 
MON 
IF 
ELS 
INI 
INI 
INI 
INI 
CLE 
IF 

I 
WRI 
IF 


(♦INITIALIZE*) 


TBOOTED 
THSC  OD 
THSC  23 
THSc  43 
THSC  63 
THSC  83 
THSC103 
THSC123 
THSC143 

justbooted 


=  EMPTYHEAP  =  NIL 


»???• 

•FEB' 
»APR» 
•JUN' 
'AUG' 
•OCT' 
•DEC' 
'  ???♦ 
THEN 


MONTHS.C  13 
MONTHSC  33 
MONTHSC  53 
MONTHSC  73 
MONTHSC  93 
M0NTHSC113 
M0NTHSC133 
M0NTHSC153 
INITHEAP 


•JAN' 
•MAR' 
»MAY» 
•JUL' 
'SEP' 
'NOV 
•???• 
»???' 


E  RELEASE(EMPTYHEAP) ; 

TUNITABLE;  CANO  THE  DATE,  FILENAMES,  ♦SYSTEM. STARTUP3 

TFlLES; 

TSYSCOM;  (♦AND  SOME  GLOBALS*) 

tworkfile; 
arscreen; 

SYSCOM^,MISCINFO.HAS8510A  THEN 

nitcharset; 
tel m( output) ; 
justbooted  then 
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701  ^  1:2  5b9  IF  NOT  STARTUP  ThlN 

702  H  1:3  ^oH  WITH  SYSCO'-'i'"  DO 

703  ^-  1:4  270  -iEGIivl 

704  4  i:b  27C  IF  MISCINFO.HASXYCRT  THEN 
70  5  4  1:6  26  0  ;3EGIN 

706  4  1:7  280  FGOTOXYlOtCRlINFO. HEIGHT  DIV  3); 

707  4  1:7  291  IF  FIuL-LEN  >  0  THEN 

708  4  i:8  296  WRIT£(OUTPUTtFILL£R) ; 

709  4  l:&  306  END; 

710  4  1:5  306  WRITELN{0UTPUT,»WELC0W|E   'tSYVlD.N   TOM; 

711  4  1:5  356  WRITELrj(OUTPUT)  ; 

712  <+  1:5  362  WRITELN{OUTPUTi»U,C.S.D.   PASCAL   SYSTEM   II. 0'); 

713  •+  1:5  408  WRITELN(OLITPUT)  ; 

714  4  1:5  414  ^ITH  THEDATE  DO 

715  4  1:6  414  WRITE(OUTPUTt ♦CURRENT  DATE  IS   • .DAY. »-» ,M0NTHSCM0NTHD. •-• t YEAR) ; 

716  4  1:5  500  WRITELNtOUTPUT) ; 

717  4  1:4  506  END   ELSE   CN0THING3 

718  4  i;i  508  ELSE 

719  4  1:2  510  WRITelN(OUTPUT. 'SYSTEM  RE-INITIALIZED') 

720  4  1:0  547  END  ( *INITIALIZE*)  ; 

721  4  1:0  564 

722  4  l:0  564 

723  4  1:0  564  C$1  SYSSegS.A  1 

723  4  l:0  564  C$1  SYSSegS.B  1 

724  4  1:0  564 

725  4  1:0  564  {****^********************^^****************'ti*****iti********** 

726  4  1:0  564  {♦  *) 

727  4  1:0  564  (*   COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.    *) 

728  4  1:0  564  (*   PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-     *) 

729  4  1:0  564  (*   TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE    *) 

730  4  1:0  564  (♦   OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS.  *) 

731  4  1:0  564  (*  ♦) 

732  4  1:0  564  (****♦*******♦♦*♦*************************♦♦♦*♦****♦****♦#♦♦♦*****♦} 

733  4  1:0  564 

734  4  1:0  564 

735  5  1:D  3  SEGMENT  FUNCTION  GETCMD (LASTST:  CMDSTATE):  CMDSTaTE; 

736  5  1:D  4  CONST  ASSEMONLY  =  LINKANDGO; 

737  5  i:u  4  TYPE   STAT  JS_ASSOCIATE  =  ( FOU'MD^OK » FOUND-BAD .  NOT_FOUND )  ; 

738  3  1:d  4  VAR  CH:  CHAR;  BADCMD:  BOOLEAN; 

739  5  1:D  6  DOnT-CARE  :  STATUS.ASSOCIATE; 

740  5  1:D  7 
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4:d 
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4:d 

51 
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0 
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0 
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4:i 
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4:i 

11 
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4:i 

21 
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5 

4:i 

27 

765 

5 

4;2 

33 
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5 

4:3 

33 

767 
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4:4 

56 
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4:5 

42 
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4:4 
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770 
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4:5 

71 

771 
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4:3 

98 

772 
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773 
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4:i 

100 

774 

5 
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149 
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151 
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153 

PROcEDjRt:  RU.'^JwORKFlLL(OKTOLlNK,  KUNONLy:  BOOLEAN); 
FORWARD; 

FUNCTION  SYS_ASSOClATE(SYS-NA^E:SrSFILE) :BOOLEaN; 

forward; 

FUNCTION  associate(Title:  string;  oktolink,  runonly»error_ok:  boolean; 

VAR  ASS-STATUS  :  status_associate ) :  boolean; 
label  1; 

VAR  rslt:  iorsltwd;  lseg:  segrange; 
sestbl:  record 

DisKiNFo:  array  csegrangej  of  SEGDESC; 
segname:  array  csegrangej  of 

PACKED  array  CO.. 73  OF  CHAR; 
SEGKIND:  array  CSEGRANGE3  OF. 

(LINKED.H0STSEG,SEGpR0CtUNlTSEGfSEPRTSE6) i 

filler:  array  C0..1433  of  integer 

END  C  SEGTBL  1    \ 
BEGIN 

ASS>STATUS  :=  NOT-FOUND; 
ASSOCIATE  :=  FALSE! 

F0PEN(USERINF0,C0DEFIBP^, TITLE. TRUE. NIL) ; 
RSLT  :=  SYSCOM'^.IORSLTJ 

IF  rslt  <>  inoerror  then 

BEGIN 

IF  error«ok  then 

IF  RSLT  =  IBADTITLE  THEN 

WRITE(0UTPUT, 'ILLEGAL  FILE  NAME') 
ELSE 

WRITECOUTPUT. 'NO  FILE  ♦, TITLE); 
GOTO  1 
END; 
ASS-STATUS  :=  FOUNU_BAD;  CUNTIL  SHOWN  OTHERWISE] 
WITH  USERINFO.SYSCOM"  DO 

IF  CODEFIBP'^.FHEAOER.DFKINO  <>  CODEFILE  THEN 
BEGIN 

WRITE(0UTPUT. TITLE. '  NOT  CODE'); 
GOTO  1 
END 
ELSE  iq 

BEGIN 
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368 
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379 
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816 
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407 

617 
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620 
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462 

621 

5 
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470 
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if  :8 

480 

«Jf^)ITPE'^D{CODE:FIBP".FU■^JIT,SE:GTBLtSIZEOF(SEGTBL)  , 

CjDEFlBO'^.FHEADER.DFIRSTBLK)  ; 
IF    lORESULT    <>    ORDdNOERROR)     THEN 

WRITE(OUTPUT. 'BAD  BLOCK  ttO')? 
GOTO  1 

end; 

WITH  SEGTBL  DO 

FOR  LSEG  :=  0  TO  MAXSEG  DO 

IF  (segkiimd[:lseg:<linked)  or  (segkind[:lseg3>seprtseg)  them 

3EGIN  1:  PRE  1.5  CODE. ..FIX  UP!  1 

FILLCHAR(SEGKIND»  SIZEOF ( SEGKIND) 1  ORD(LINKED) ) ; 
FILLCHAR(FILLER,  SIZEOF ( FILLER ) .  0)J 
UNITWRITE(C0DEFIBP''.FUNIT,  SEGT8L1  SIZEOF(SEGTBL)  1 
CODEFIBP'^.FHEADER.DFIRSTBLK) 
END; 
vilJH    SEGTBL  00 

FOR  LSEG  :=  0  TO  MAXSEG  DO 

IF  SEGKINDCLSEGD  <>  LINKED  THEN 
BEGIN 

IF  oktolink  Then 

BEGIN  WRITELN( OUTPUT. 'LINKING.,.') ; 
FCLOSE(CODEFIBP'*.  CNORHAL); 

IF  sys-associateclinker)  then 

BEGIN 

IF  runonly  then  getcmd  :=  linkandgo 

else  GETCMD  :=  LINKDEBUG; 
EXIT(GETCMD) 
END 
END 
ELSE 

IF  NOT  (LASTST  in  CLINKANDGO*  LINKDEBUGD)  THEN 
WRITE(0UTPUT,'MUST  L(INK  FIRST'); 
GOTO  1 

end; 
for  lseg  :=  1  to  maxseg  do 

if  (lseg  =  1)  or  (lseg  >=  7)  then 

WITH  SEGTABLECLSEG:, SEGTBL. DISKINF0CLSEG3  DO 
BEGIN  CODEUNIT  :=  CODEFlBP'' .FUNIT : 
CQDEUESC.CODELENG  :=  CODELENG; 

CODEDESC.Dir  'DDR  :=  DISKADDR+ 
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CODEFIBP-.FHEADER.DFIRSTBLK 

E!\lD; 

ass-status  :=  found_ok; 
ASSOCIATE  :=  true; 

:       FCLOsE{USERIf\iFO,cODEFlBP'",CNORMAL) 
ENO    (*ASS0CIATE*)     ; 

FUMCTIOM    SyS_ASSOCIATEC(SYS_NAME:SYSFlLE):BOCLEANJ; 

VAR  VOL  :  vid; 
Title  :  tid; 
SEGS  :  integer; 
Kind  :  filekind; 
LUNiT  :  unitnum; 

LTITLE  :  FULL.ID; 

ASS-STATUS  :  STATUS-ASSOCIATE; 

BEGIM 

SYS_ASS0CIATE  :=  ASSOCIATE (FILENAMECSYS.NAME3. FALSE, FALSE, FALSE. ASS  STATUS): 
IF  ASS-STATUS  =  NOT-FOUND  THEN 

IF  SCANTITLE(FlLENAMECSYS-NAME3,V0L»TITLEfSEGS,KlND)  THEN 
BEGIN 

LUNIT  :=  0; 

REPEAT 

LUNIT  :=  LUNIT  +  IJ 

WITH  UNITABLECLUNITD  DO 

IF  UISBLKD  THEN 

BEGIN 

uviD  :=  ♦»; 

IF  FETCHDIR(LUNIT)  THEN 
BEGIN 

UVID  :=  SYSCOM'^.GDIRP'^COD.DVIDJ 
LTITLE  :=  C0NCAT{UVID»»:», TITLE); 
IF  LTITLE  <>  FILENAMECSYS-NAME3  THEN 

IF  ASSOCIATECLTITLE, FALSE. FALSE, FALSE, ASS-STATUS)  THEN 
FILENAMECSYS-NAMED  :=  LTITLE? 
END; 
end;  C  OF  IF  ISBLOCKED  ..,3 
UNTIL  (LUNIT  =  MAXUMIT)  OR  (ASS-STATUS  IN  CFOUND-OK ,F0UND-BAD3) I 
SYS-ASSOCIATE  :=  ASS-STATUS  =  FOUND-OK; 
IF  ASS_STATUS  =  NOT. FOUND  THEN 

IF  ASSOCIATE (FILENAME: SYS-NAMED, FALSE, FALSE, TRUE, ASS.STATUS)  THEN;   21 
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CJUST    TO    GET    THE    APPKOPRIATE    ERROR] 
::N0;    COF    if    iSCANTlTLE...  3 
LixJD:       COF    SYS-ASSOCIATED 

PROCEDURE  STARTC0NPILE(NEXTST:  CMDSTATE); 
LABEL  i; 
VAR  TEXT.TITLE. TITLE:  STRINGC  fO  :i ; 

I  :  INTEGER; 

CoDt.NAME  :  FULL^ID; 

SYS_TYPE  :  sysfile; 

BEGIN 

IF  NEXTST  =  ASSEMONLY  THEN 

WRITE(0UTPUT. 'ASSEMBLING* ) 
ELSE 

WRIT£(0UTPUT, 'COMPILING' ) ; 
WRITELNOUTPUT. ',..')  ; 
IF  NEXTST  =  ASSEMONLY  THEN 

SYS. TYPE  :=  ASSM8LER 
ELSE 

SYs.TYPE  :=  COMPILER? 

IF  sys-associate(SYs«type)  then 

WITH  USERINFO  do 
BEGIN 

IF  GOTSYM  THEN 

TITLE  :=  CONCAT(SYMVID»»:»»SYMTID) 
ELSE 
BEGIN 

IF  NEXTST  =  ASSEMONLY  THEN 

WRITE(0UTPUT»  'ASSEMBLE') 
ELSE 

WRITE(0UTPUT.  'COMPILE'); 
WRITE(OUTPUT»'  WHAT  TEXT?  •); 
READLN(INPUT»  TEXT. TITLE); 
IF  TEXT. TITLE  =  "  THEN  GOTO  1; 
TITLE  :=  CONCAT(TEXT. TITLE, '.TEXT') ; 

end; 

FOPEN  (  S  YMF  iBP'^t  TITLE.  TRUE  »  NIL)  ; 
IF  lORESULT  <>  ORD(INOERROR)  THEN 
BEGIN 

WRITE(OUTPUT.'CAN"T  FIND  ',  TITLE); 

GOTSYM  :=  FALSE,'  ^OTO  1 
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end; 

TITLE    :=    CorjCAT(COPY(!^lLENAMECSYS.TYPE],l, 

POS( • : NFILENAMECSYS-TYPED) )»• SYSTEM, SWAPDISK • ) ; 
F0PEN{SWAPFIB'*,  TITLE  »  TRUE,  NIL)  ; 
CODE_NAME    :=    ♦*SYSTEM. ^RK.C0DEC*3' ; 
IF    NOT    GOTSYM    THEN 
BEGIN 

ifJRITE(  OUTPUT.     'TO    WHAT    CODEFILE?    *); 
READLNd'MPUT,    TITLE); 
IF    TITLE    <>    "    THEN 

IF    TITLEC13    =    SYSCOW^.CRTINFO.ALTMODE    THEN 
GOTO    1       ELSE 

BEGIN  CTREAT    •$•    AS    A    WILDCARD3 

I    :=    POS(»$», TITLE) ; 
WHILE    I    <>    0    DO 
BEGIN 

DELETE(TITLE»I.l); 

INSERT{C0PY(TEXT.TITLE»1»LENGTH(TEXT.TITLE))» 

TITLEfl); 
I  :=  P0S(»$»iTITLE)5 
END; 

IF  TITLECLENGTH(TITLE)3  <>  *  2*    THEN 

CODE-NAME  :=  CONCAT( TITLE. « .C0DEC*3» )   ELSE 

code-name  :=  title; 
end; 
end; 

f0pen{c0defibp''.  code-name,  false.  nil)  ? 
if  loresult  <>  ord(inoerror)  then 

BEGIN 

WRITE(OUTPUT.'CAN»»T  OPEN  » .CODE-NAME) ; 

GOTO  1 
END; 
ERRNUM  :=  o;  ERRBLK  :=  Q;  ERRSYM  :=  O; 
IF  NEXTST  =  ASSEMONLY  THEN 

NEXTST  :=  componly; 

GETCMD  :=  NEXTST?  EXIT ( GETCMD) ; 

i: 

FCLOSECSYMFIBP'^.CNORMAL)  ; 
FCLOSE(SWAPFlB'^,CNORMaL)  ; 

eno; 
end  (*startcompile*)  ;  23 
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Pi^OCEUjqE:    FINISHCOMPILE; 
VAR       RESULT     :     IfJTEGtK; 
b  E  5 1  r  J 

FCLOsECUSERINFO.sYMFIBP'^iCNORMAL)  ; 

FCL0SE(SWAPFI3".CN0R|W!AL)  ; 

IF    SrSCOM-^.NlISClMFO.HASBSlOA    THEN 

Ui\iITCLEAR(3)  ; 
WITH    USERINFO    DO 

IF    ERRNUiM    >    0    THEN 

BEGIN  GOTCODE  '•-    FALSE; 

FCLOSECCODEFlBP'^tCPURGE)  ; 
IF  ERRBLK  >  0  THEN 

3EGIN  CLEARSCREEN;  WRITELN (OUTPUT ) 5 
IF  SYS_ASS0CIATE(EDIT0R)  THEN 

BEGIN  GETCMD  :=  SYSPROG?  EXIT(GETCMD)  END 
END 
END 
ELSE 
BEGIN 

IF  CODETID  <>  'SYSTEM. WRK. CODE*  THEN 
BEGIN 

CODEVID  :=  CODEFIBP'^.FVID; 
CODETID  :=  CODEFIBP'^.FHEADER.DTID; 
IF  CODETID  <>  'SYSTEM. WRK.C0DE»  THEN 
BEGIlNj 

WORKVID  :=  CODEVID; 

IF  LENGTH(CODETID)  >  5  THEN 

IF  C0PY(C0DETID,LENGTH(C0DETlD)-4,5)  =  '.CODE'  THEN 
WORKTID  :=  C0PY(C0DETIDtlfLENGTH(C0DETID)-5) ; 

end; 
end; 
gotcode  :=  true; 

CFIB  FOR  CODEFILE  WAS  CLOSED  IN  COMMAND^ 
IF  LASTST  IN  CCOMPANDGO, COMPDEBUG 3  THEN 
RUNWORKFlLt;(TRUE»  LASTST  =  COMPANDGO) 

END 
END  (*FINISHC0MPILE*)  ; 

PROCEDURE  EXECUTE; 

VAR    titll:    STRI;nIGC255D; 
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WRITE (OUTPUT. 'EXECUTE') ; 


IF  NiDT  SYSCOM'^.MiSCINFO.SlOwTERM  THEN 

WRITE(0UTPUT. •  WHAT  FILE'); 
WRITE(OUTPUT,'?  •);  READLN(TITLE) ; 
IF  LENSTHCTITLE)  >  0  THEN 

BEGIN 

IF  TITLECLENGTH(TITLE)3  =  '.'  THEN 

DELETE (TITLE  I  LENGTH (TITLE),1) 

ELSE 

INSERT ('.CODE', TITLE, LENGTHi TITLE )+l); 

IF  associate(TItll»  False,  false,  true,  dont.care)  then 

BEGIN  GETCMD  :=  SYSPROG;  EXITCGETCMD)  END 
ENO 
END  (*EXECUTE*)  ? 

PROCEDURE  RUNWORKFILE; 
BEGIN 

WITH  USERINFO  DO 
IF  GotCODE  THEN 
SESIN 

CLEARSCREEN; 
WRITELN(OUTPUT)? 

IF  associate(COncaT(codevid,':',codetio),  oktolink,  runonly,  true, 

DONT.CARE)  THEN 
BEGIN 

WRITELNC OUTPUT, 'RUNNING. . .  •  )  { 
IF  RUNONLY  THEN 

GETCMD  :=  SYSPROG 
ELSE 

GETCMD  :=  DEBUGCALL? 
EXIT(6ETCMD) 
END? 

IF  NOT  (LASTST  IN  CLINKANDGO,  LINKDEBUG3)  THEN 
GOTCODE  :=  FALSE 
END 
ELSE 

IF  RUNONLY  THEN 

STARTCOMPILE(COMPANDGO) 
ELSE 

STARTC0MPILE(C0MPdEBU6)  25 
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r^EoiN    ( *':.ETC.iu*) 

INPLITFie'^.FEOF     :=    FALSl; 
0UTPlITfI3'".FE0F    1=    FALSE? 

SYSTER-r.FLOF     :=    FALSE; 

gfileslq]  :=  inputfib;  gfilescid  :=  outputfib; 

IF  LASTST"  =  HALTIiNllT  THEN 

IF  ASS0CIATE( • *SYSTEM. STARTUP ', FALSE , FALSE . FALSE , DONT«CARE )  THEN 
BEGIN  CLEARSCREEN; 

GETCi'^D  :=  SYSPKOG;  EXIT(GETCMD) 

ENj; 

if  lastst  in  c  coiviponly  ,  compandgo  .  compdebugd  then 

finishcO'Jipile; 
IF  lastst  in  clinkandgo,linkdebugd  then 

runworkfile(false.  lastst  =  linkandgo); 
if  syscom'^.miscinfo.userkind  =  aquiz  then 

if  lastst  =  haltinit  then 

BEGIN  lastst  ;=  COMPANDGO;  RUNWORKPILE ( TRUE »  TRUE)  END 

ELSE 

BEGIN 

emptyheap  :=  nil; 
getcmd  :=  haltinit; 
exit(getcmd) 

end; 
with  userinfo  do 

BEGIN  ERRNUM  :=  05  ERRBLK  :=  0;  ERRSYM  :=  0  END; 

BADCMD  :=  false; 

REPEAT 

PL  :  = 

•command:  e(dit.  r(un.  f(ile»  c(omp,  lcink.  x(ecute,  a(ssem,  d(ebu6t7  cii.gd' 
prompt;  ch  :=  getchar(Badcmd) ;  clearscreen; 

IF  Ch  :^  '?•  THEN 

BEGIN  PL  :=  •command:  U{SER  restart.  KNITIALIZE*  H(ALT»; 

PROMPT;  CH  :=  getcharcbadcmd) ;  clearscreen 

ENr; 
BADCMD  :=  not  (ch  in  C'E' f •«♦ . 'F' , 'C* , 'L' . 'X» , 'A* , 'D' » 'U' . ♦!• . 'H* . •?'3) ; 
IF  NOT  BADCMD  then 
CASE  CH  OF 

'E':   BEGIN  wRlTELN(OUTf=UT)  ; 

IF  SYS^ASSOCI^  '(EDITOR)  THEN 


t5°^  "^  ^-^  ^^'^                                                     3EGIN  GlTCMu  :=  SYSPROG;  EXIT(GETCMD)  END 

1070  5  i;i+  374             end; 

^°"^1  -"^  1«3  576          »F':   BEGIN  wRlTELN  ( OUTPUT )  ; 

]^1^  ^  1-^  ^^2                   IF  SYS-ASSOCIATE(FILER)  THEN 

1073  5  i:6  369                    BEGIN  GETCMd  :=  SYSPROG;  EXIT(GETCMD)  END 

l^''^  5  !:<+  39b                END; 

1075  a  i;3  53d                           '1*1       BEGIN  k'^RITELN  ( OUTPUT  .•  LINKING.  ,.♦)  ; 

j-J^=  ^  i-^  '+24                   IF  SYS_ASS0CIAT£(LINKER)  THEN 

JSn  ^  ^'°  "+^1                    BEGIN  GETCMD  :=  SYSPROG;  EXIT(GETCMD)  END 

1078  5  1:4  438                END; 

1079  5  1:3  440       'x':  execute; 

^0^0  ^  1'3  444          'C*:   STARTCQMPILE(COMPONLY) ; 

1081  5  1:3  449          »A':   STARTCOMPILE(ASSE^ONLY) ; 

1°^2  5  1:3  454          fU':   IF  LASTST  <>  UPROGNOU  THEN 

1083  5  1:5  459                   BEGIN 

1084  5  1:6  459                    IA/RITELN(0UTPUT, 'RESTARTING. ,.•)  ; 

1085  5  1:6  ^88                    GETCMD  :=  SYSPROG;  EXIT(GETCMD) 
1036  5  1:5  495                  END 

1087  5  1:4  495                £LSE 

Intt  i  Y'^  '^^^                  2^^^^'  WRITELN(OUTPUT);  WRITE  (OUTPUT,  »U  NOT  ALLOWED')  END; 

1089  5  1:3  528      'R't'D':   RUNWORKFILE { TRUE ♦  CH  =  'R'); 

1090  5  1:3  536      '1','H':   BEGIN 

1091  5  1:5  536                  GETCMD  :=  HALTINIT; 

1092  5  1:5  539                  IF  CH  =  'H'  THEM 

1093  5  life  544                    E^pTYHEAP  :=  NIL; 

1094  5  1:5  548                  EXIT(GETCMD) 

1095  5  1:4  552                END 

1096  5  1:3  552        END 
1057  5  1:1  610    UNTIL  FALSE 

1098  5  1:0  610  END  (*GETCMD+)  ; 
i099  5  1:0  634  C$1  SYSSEGS.3  2 

1099  5  1:0  634  C$1  SYSTEM. A  ] 

1100  5  1:0  634 

1101  5  1:0  634      (*************************************************#***#******4c*****) 

1102  5  l:c  634      (*                                                                 ^j 

ilnu  I  }'°  ^^"^               ^*       COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.    ») 

,tn2  !  *°  ^^'*      ^*   PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-     *) 

itn?  c  :'^  °^'^               **   NATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE    *) 

^t„°  ^  ^'^  °^'^               <*   OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS.           *) 

1107  5  i:0  634      {*                                                                    ,j 

1108  5  1:g  634      (********♦*******************♦******♦*****♦***♦♦♦******♦**#♦#*##+#,) 


2- 


1109    b     11 n 


b 


iiij   c   ^^ir  i   p«ocedjre:  priltlocs; 

1115  1  ^^^^^^^ 

1116  0          T^\l  1?  ''^^~    ^ySCOM-.SYScO^^-.BOMBP-    00 

1118  0         ^lll  35  ^^RITf:(OUTPUT,'S«    '.msseg-.sytecod, 

1119  0          4^:3  Hi  ''     ^^     ''MSJTAB-.BYTECOJ. 

1121  0          4^4  la  ^'    MlSCir^FO.lS.FLlPT    THE.J 

1122  0          ll':l  99  ^jmiELNrMSIPC) 

J-127  n            2:0  0    BEGIN 

]i;t  i            2:1  0  WITH    SYSCOM-    DO 

1130  0               .  ^  ^^^^^' 

1131  0            i'-l  -,?  ^'''    ''^Q^RR    =    '*    THEN 

1132  0          2'^  ]l  3'"^^   Re:lease{emptyheap); 

1133  0     2*5  \t  ^^    •=  '*'^'^'^  OFLOW*.. 

1134  0     2*5  fq  UNITWRITE(2.PLCn,LENSTH(PL)); 

1135  0     2:1  5I  .  c.XIT(COMMArgQ) 
113S  0     ?w  ,  -^^^' 

1137  0     ?'^  ??  B0v,3P-.MSIPC  :=  BOMBIPC: 

1138  0     2*4  'T  ^^  3UGSTATE  <>  G  THEN 

1139  0     2-3  75  c.  ^^'^^''  debugger;  XEQERR  ;=  0  END 
11^0  0            2*4  77  ^^^, 

1141  0     2-5  11  ^^'^•^''^  RELEASE(£MPTYHEAP): 

ll'+2  0     2:5  15?  IPILESCOI  :=  INPUTFIB;  GFILESClH  :=  OUTPUTFIB- 

ll'^3  0     2:5  113  ^rTV""^    '=    lORESULT;  FWRITELN  ( SYSTERM^)  ; 

m  2     1:1  J-  P'^I^T^.I;.'^^^^^^^^^^^^^                                                                                                  0UT3,  THE. 

1147  u            2-7  IU1  BEGIN 

il'+S  0     217  177  WRIT£LN(OUTPUT,'EXEC  ERR  U     •, XEQERR)  5 

1149  0     2-8  Ip^  ^   XEiER«  =  10  THEfg 

•^  WRlTECaUTPUT.'   »30M3IPC) 


115Q  0  2:6  2M              rr.jo; 

^^^1  '^  2:5  201            PRINTLOCS; 

1152  J  2:5  203            IF  r.OT  SPACEWA  IT  ( TRUE )  THEN  EXIT(COMMAND) 

1153  0  2:4  215          rfjO 
115£+  u  2:2  215      END 

^^^5  0  2:0  215  END  {*EXtCERROR*)  ; 

1156  G  2:0  230 

1157  0  (+5:0      3  FUNCTION  CHECKDEL(CH:  CHAR;  VaR  SINX:  INTEGER):  BOOLEAN; 
1156  0  45:0      0  BEGIN  CHeCKDEL  :=  FALSE; 

1159  G  45:1      3    WITH  SYSCOM'^tCRTCTRL  00 

1160  0  if5:2     13      BEGIN 

U&l  0  f5:3     13        IF  CH  =  CRTINFO.LINEDEL  THEN 

1162  0  '15:4     23          BEGIN  CHECKDEL  :=  TRUE; 

^^tl  n  im            ft                              ^^    (BACKSPACE  =  CHR(O))  OR  (ERasEEOL  =  CHR(O))  THEN 

1164  0  45:6     45              BEGIN  SINX  :=  1; 

1165  0  45:7     48                WRITELN(OUTPUT»»<DEL») 

1166  0  if5:6     68              END 

1167  0  «+5:5  68            ELSE 

1168  0  15:6  70              BEGIN 

1169  0  45:7  70                WHILE  SINX  >  1  DO 

117?  n  a^i?  It                                              ^^^^^    ^^^^    •=  SINX-l;  WRITE (OUTPUT, BACKSPACE)  ENDl 

i.-ri  ;  .Z  ^^                                        WRITE(OUTPUT. ESCAPE. ERASEEOL) 

1172  0  1+5:6  121              END 

1173  0  '+5:4  121          EMD; 

1174  0  1+5:3  121        IF  CH  =  CRTINFO.CHARDEL  THEN 

1175  0  45:4  131          3EGIN  CHECKQEL  :=  TRUE; 

1176  0  ^+5:5  134            IF  SINX  >  1  THEN 

i:ll  °  '*^*^  ^^^                                   BEGIN  SINX  :=  SINX-l; 

tj;°  °  ;^5'7  146                IF  BACKSPACE  =  CHR(O)  THEN 

i,In  n  .V^  ^^°                                            ^^    CRTINFO.CHARDEL  <  •  •  THEN 

1180  0  45:9  166                    WRITE ( OUTPUT .»_» ) 

.^Zi,  2  !*?*®  ^^'*                  ^"-SE  {*ASSUME  PRINTABLE*) 

1182  0  45;7  176                ELSE 

1183  0  45:8  178                  BEGIN 

IJar  S  IV.l  11^                                                   ^^    CRTINFO.CHARDEL  <>  BACKSPACE  THEN 

ii«'  2  al  ^^^                                                        WRITE{OUTPUT, BACKSPACE) J 

itf?  0  nil  227                  ^^WRITE(0UTPUT,.  •, BACKSPACE) 

1188  0  45:6  227              END 

1189  0  45:5  227            ELSE 

1190  0  45:6  229              IF  CRTINFO.CHARDEL  =  BACKSPACE  THEN                               29 
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1191 

Q 

^+5:7 

^44 

1192 

a 

'+'D:'f 

252 

1193 

0 

Hb-.S 

2b2 

1194 

0 

45:0 

d.62 

1195 

0 

45:0 

2o& 

1196 

0 

45:0 

266 

1197 

Q 

46:0 

1 

1198 

0 

46:0 

0 

1199 

0 

46:i 

0 

1200 

Q 

46:2 

5 

1201 

0 

46:3 

10 

1202 

0 

46:4 

10 

1203 

J 

46:5 

20 

1204 

0 

46:4 

33 

1205 

0 

46:4 

41 

1206 

0 

46:5 

46 

1207 

0 

46:3 

56 

1208 

0 

46:o 

56 

1209 

0 

46:o 

68 

1210 

0 

36:d 

1 

1211 

0 

36:o 

0 

1212 

0 

36:i 

0 

1213 

0 

36:o 

11 

12m 

0 

36:o 

24 

1215 

0 

37:d 

1 

1216 

0 

37:0 

0 

1217 

0 

37:1 

2 

1218 

0 

37:2 

12 

1219 

0 

37:3 

12 

1220 

0 

37:3 

15 

1221 

0 

37:4 

25 

1222 

0 

37:3 

32 

1223 

0 

37:4 

36 

122*+ 

0 

37:2 

43 

1225 

0 

37:o 

45 

1226 

0 

37:0 

58 

1227 

0 

38:d 

1 

1228 

0 

3a:o 

0 

1229 

0 

38:i 

0 

1230 

0 

38:o 

9 

1231 

0 

^8:0 

24 

WRITE ( OUTPUT  1  •     ») 

EfJO 
END     (*CHrcKD£.L*)     ; 

PROCEDURE  PUTPREFIXED(WHICH:INTEGER;  COMMANDCHAR : CHAR ) ! 
5EGI'M 

WITH  SYSCO"'!'*  DO 

IF    CQfwlMAfMOCHAR    <>    CHR(O)     THEfJ 
BEGIN 

XF  CRTCTKL.PREFIXEDCWHICH:  THEN 

write(output.crtctrl. escape) ; 
^jrlt£(output,commandchar)  ; 
:f  fill_len>o  then 

write(output«filler) ; 

end; 
end; 

procedure  homecurscr5 

BEGIN 

PUTPREFlXED(4tSYSC0M''.CRTCTRL.H0ME)  ; 
END  (*H0MECURS0R*)  ; 

PROCEDURE  clearscreen; 
BEGIN  HOMECURSOR; 

WITH  SYSC0M'*,CRTCTRL  DO 

BEGIN 

unitclear(3) ; 

IF  eraseeos  0  chr{o)  then 

PUTPREFIXED(3.tRASEE0S) 
ELSE 

PUTPREFIXED(6tCLEARSCREEN) 
END 
END  (*CLEARSCREEN*)  ; 

PROCEDURE  CLEARLINE; 
3EGIN 

PUTPREfiXE0{2iSYSC0M''.CRTCTRL.ERASEE0L) 
END  (*CLeaRLINE*)  ; 


1252  ,j  39  :o      i  PROCEDURE  PROi^lPT; 

1233  u  39 :d      1    VAR  i:  INTEGER; 

1234  0  39  :o      G  BEGIN  HO''/1ECURSOR  ; 

1235  0  39:i      2    WITH  SysCOiV'^  DO 

1236  0  39:2      7      3E.GIH 

1237  0  39:3      7        CLeaRLINE; 

1238  0  39:3      9        IF  MiSC INFO. SLOWTERM  THEN 

1239  0  39:4  17          BEGIN 

1240  0  39:5  17             I  :=  SCAN{LENGTh(PL) ,=• : »,PLC13) J 

1241  0  39:5  33            IF  I  <>  LENGTH(PL)  THEN  PLCOD  :=  CHR(I+1) 

1242  0  39:4  49           END 

1243  G  39:2  50      END? 

1244  U  39:i  50    WRITE ( OUTPUT , PL ) 

1245  0  39:o  60  END  (*PRomPT*)  ; 

1246  0  39:0  72 

1247  0  29:D      1  PROCEDURE  FGOTOXY ( *X , Y :  INTEGER*); 

1248  0  29:o      0  BEGIN  (*ASSUME  DATA  MEDIA*) 
12'*9  0  29:1      0    WITH  SysCOM'^  .CRTINFO  DO 

1250  0  29:2      7      3EGlN 

1251  0  29:3      7        IF  X  <  0  THEN  X  ?=  O; 

1252  0  29:3  15        IF  X  >  WIDTH  THEN  X  :=  WIDTH? 

1253  0  29:3  25        IF  Y  <  0  THEN  Y  :=  O; 

1254  0  29:3  33        IF  y  >  HEIGHT  THEN  Y  :=  HEIGHT 

1255  0  29:2  39      END? 

1256  0  29:i  43    WRiTEt OUTPUT, CHR ( 30 ) tCHR { X+32 ). CHR ( Y+32 ) ) 

1257  0  29:0  71  END  (*GOtOXY*)  ; 

1258  0  29:0  84 

1259  0  tfi:D      3  FUNCTION  GETCHAR  (  *FLUSH:  BOOLEAN*); 

1260  0  41:d      4    VAR  CH;  CHAR; 

1261  0  "+1:0      0  BEGIN 

1262  0  4i:i      0    IF  FLUSH  THEN  UNITCLEAR ( 1 )  ; 

1263  0  4i:i      6    IF  INPUTFIB'^.FEOF  THEN  EXIT  ( COMMAND )  ; 
126*+  0  4l:i  16    INPUTFIB'^.FSTATE  :=  FNEEDCHAR; 

1265  0  4i:i  23    READ(INPUT,CH); 

1266  0  4l:i  31    IF  (CH  >=  'A')  AND  (CH  <=  »Z')  THEN 

1267  0  41:2  40   ■    CH  :=  CHR (ORD ( CH ) -ORD ( » A ♦ ) +ORD ( • A • ) ) ; 

1268  0  4l:i  47    GETCHAR  :=  CH 

1269  0  4l:0  47  END  (*GETCHAR*)  ; 

1270  0  4l:0  62 

1271  0  40:D      3  FUNCTION  SPACEWAIT ( *FLUSH:  BOOLEAN*);                                              ^ 

1272  0  40:0  4    VAR  CH;  CHAR;                                                                      31 
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1273 

0 

4o:o 

0 
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0 
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0 
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G 
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1276 

J 
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22 

1277 

0 

40:3 

33 

1278 

0 

40:2 

55 

1279 

0 

40:2 

62 

i2oO 

0 

40:3 

73 

1281 

0 

40:2 

79 

1282 

0 

4o:i 

79 

1283 

0 

4o:i 

97 

1284 

0 

4o:o 

93 

1285 

0 

4o:o 

116 

1286 

0 

i:d 

3 

1287 

0 

33:d 

49 

1288 

0 

33:d 

49 

1289 

0 

33:o 

0 

1290 

0 

33:i 

0 

1291 

0 

33:i 

17 

1292 

0 

33:i 

23 

1293 

0 

33:i 

29 

1294 

0 

3312 

38 

1295 

0 

33:3 

45 

1296 

0 

33:3 

59 

1297 

0 

33:4 

61 

1298 

0 

33:5 

61 

1299 

0 

33:6 

72 

1300 

0 

33:5 

83 

1301 

0 

33:4 

85 

1302 

0 

33:2 

89 

1303 

0 

33:i 

91 

1304 

0 

33:2 

99 

1305 

0 

33:3 

99 

1306 

0 

33:4 

107 

1307 

0 

33:3 

120 

1308 

0 

33:3 

133 

1309 

0 

33:4 

139 

1310 

0 

33:5 

139 

1511 

0 

33:5 

152 

1312 

0 

33:4 

165 

1313 

0 

33:3 

165 

kepeat 

WRITe(OUTPUT, 'TYFL  <SPACE>' ) ; 

IF    ^OT    SrSCOM'^.wilSCINFO.SLOWTLRM    THEN 

WRlTE(OUTPUTi •  TO  CONTINUE'); 
CH  :=  GETCHAR(FLUSH) ; 
IF  KOT  EOLN(INPJT)  THEN 

WRlTELN(OUTPUT) ; 
CLEARLINE 
UNTIL  CH  =  •  •)  OR  (CH  =  SYSCOM-^,  CRTINFO.  ALTMODE )  ; 
SPACElNAlT  :=  CH  <>  '  • 
END  (*SPACEiAlAlT*)  ; 

FUNCTION  scantitle(*ftitle:  string;  var  fvid:  vid;  var  ftid:  tidi 

vAR  fsegs:  integer;  var  fkind:  filekind*); 

VAR  i.rbrack:  integer;  ch:  char;  ok:  boolean; 
begin 

fvid  :=  ••;  FTID  :=  ••; 

fsegs  :=  0;  FKIND  :=  untypedfile; 

SCANTITLE  :=  FALSE;  I  :=  i; 
WHILE  I  <=  LENGTH(FTITLE)  DO 
begin  CH  :=  FTITLECID; 

IF  cH  <=  •  •  THEN  DELETE(FTITLE»I,1) 
ELSE 
3EGIN 

IF  (CH  >~  »AM  AND  (CH  <=  »Z»)  THEN 

FTITLECID  :=  CHR(ORD(CH)-ORD( 'A* )+0RD( 'A* ) ) ; 

I  :=  i+i 

^:no 
end; 
if  len3th(ftitle)  >  0  then 

BEGIM 

IF  FTITLEC13  =  '*•  THEN 

BEGIN  FVID  :=  SYVID;  DELETE ( FTITLE . 1 . 1 )  END; 

I  :=  Pos(':«iFTiTLE) ; 

IF  I  <=  1  THEN 
BEGIN 

IF  LENGTH(FVID)  =  0  THEN  FVID  :=  DKVID; 
IF  I  =  1  THEN  OELETE(f^TITLE,l,l) 

ELSE 
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167 

1315 

0 

33:5 
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0 
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0 
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0 
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0 

33:5 

207 

1322 

0 

33:5 

220 

1323 

0 

33:5 

228 

132if 

0 

33:5 

210 

1325 

0 

33:6 

216 

1326 

0 

33:7 

216 

1327 

0 

33:8 

252 

1328 

0 

33:7 

275 

1329 

0 

33:7 

283 

1330 

0 

33:8 

288 

1331 

0 

33:9 

291 

1332 

0 

33:9 

301 

1333 

0 

33:9 

310 

1334 

0 

33:o 

315 

1335 

0 

33:i 

321 

1336 

0 

33:2 

327 

1337 

0 

33:3 

331 

1338 

0 

33:i 

315 

1339 

0 

33:3 

351 

13tfO 

0 

33:3 

361 

1311 

0 

33:2 

363 

13«f2 

0 

33:2 

378 

13f3 

0 

33:3 

389 

1311 

0 

33:i 

100 

13'+5 

0 

33:i 

107 

1316 

0 

33:8 

107 

1317 

0 

33:7 

107 

1318 

0 

33:7 

111 

1319 

0 

33:8 

121 

1350 

0 

33:9 

121 

1351 

0 

33:9 

139 

1352 

0 

33:9 

151 

1353 

0 

33:o 

158 

1351 

0 

33  ;a 

173 

if    I-l    <=    VIDLLIMG    THEN 
3EGIN 

FVID    :=    C0PY(FTITLE»1,I-1) ; 
DELETE(FTITLE,1,I) 
end; 
IF    lENGTH(F\/ID)     >    0    THEN 
3EGIf\l 

I  ;=  POS(«C»»FTITLE) ; 
IF  I  >  0  THEN  I  :=  l-l 
ELSE  I  :=  LENGTHtFTlTLE); 
IF  I  <=  TIDLENG  THEN 
BEGIN 

IF  I  >  0  THEN 

BEGIN  FTID  :=  COPY ( FTITLE , 1 , I ) ;  DELETE(FTITLE. 1 » I )  END; 
IF  LENGTH(FTITLE)  =  0  THEN  OK  :=  TRUE 
ELSE 

BEGIN  OK  :=  FALSE; 

RBRACK  :=  POS{»D»,FTITlE); 
IF  RBRACK  =  2  THEN  OK  :=  TRUE 
ELSE 

IF  RBRACK  >  2  THEN 

BEGIN  OK  :=  true;  I  :=  2; 
REPEAT  CH  :=  ftitlecid; 

IF  CH  IN  DIGITS  THEN 

FSEGS  :=  FSEGS*10+{ORD(CH)-ORD{»0M) 

ELSE  OK  :=  false; 
I  :=  i+i 

UNTIL  (I  =  RBRACK)  OR  NOT  OK; 
IF  (I  =  3)  AND  (RBRACK  =  3)  THEN 
IF  FTITLECI-ID  =  »*»  THEN 

BEGIN  FSEGS  ;=  -1;  OK  :=  TRUE  END 
END 
END; 
SCANTITLE  :=  OK; 

IF  OK  AND  (LENGTH(FTID)  >  5)  THEN 
BEGIN 

FTITLE  :=  C0PY(FTID»LENGTH(FTID)-1,5); 

IF  FTITLE  =  '.TEXT*  THEN  FKIND  :=  TEXTFILE 

ELSE 

IF  FTITLE  =  '.CODE'  THEN  FKIND  :=  CODEFILE 

ELSE 
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1355  0  33:i  '+77  IF  FTITLE  =  '.BACK'  THEN  FKIND  :=  TEXTFILE 

135S  0  33:i  452  ELSE 

1357  J  33:2  "+56  IF  FTITLE  =  '.INFO'  THEN  FKIND  :=  INFOFILE 

1358  0  53:2  311  ELSE 

1359  0  33:3  513  IF  FTITLE  =  '.GRAF'  THEN  FKIND  :=  GRAFFILE 

1360  0  33:3  530  ELSE 

1361  0  33:'+  534  IF  FTITLE  =  '.FOTO'  THEN  FKIND  :=  FOTOFILE 

1362  0  33:a  549  END 

1363  0  33:6  551  END 

1364  0  33:4  551  ffxlD 

1365  0  33:2  551      END 

1366  0  33:0  551  END  ( *SCanTI TLE* )  5 

1367  3  33:0  576 

1368  0  33:Q  576  (*  VOLUME  AND  DIRECTORY  HANDLERS  *) 

1369  0  33:0  576 

1370  0  42:0      3  FUNCTION  FETCHDIRC ( FUNIT:  UNITNUM):  BOOLEAN^; 

1371  0  '+2:D      4    VAR  LiNX:  DIRRANGE;  OK:  BOOLEAN;  HNOW:  INTEGER; 

1372  0  12:0      0  BEGIN  FEtcHDIR  :=  FALSE; 

1373  0  'f2:i      3    WITH  SysC0M'^,UNITABLECFUNIT3  DO 

1374  0  42:2     16      BEGIN  (*READ  IN  AND  VALIDATE  DIR*) 

1375  0  42:3     16        IF  GDIRP  =  NIL  THEN  NEW(GDIRP); 

1376  0  '^2:3     30       UNlTREAD  (FUNIT  ,GDIRP'^tSIZEOF(  DIRECTORY)  tOlRBLK)  ; 

1377  0  42:3     41        OK  :=  lORSLT  =  INOERROR; 

1378  0  «f2:3     47        IF  OK  THEN 

1379  0  '♦2:4     50  IrJiTH  GDIRP*C03  DO 

1380  0  '♦2:5     57  BEGIN  OK  :=  FALSE;  {*CHECK  OUT  DIR*) 

1381  0  ^^2:6     60  IF  (DFIRSTBLK  =  0)  AND 

1382  0  42:6     64  (   { MISC INFO . USERKIND=BOOKER ) 

1583  0  ^^2:6     72  OR  (  { ^llSCINFO.USERKIND  IN  C  AQUlZtPQUIZ:)  AND  ( DFKINDsSECUREDIR ) 

1584  0  i^2:6     90  OR  {  { MISCINFO.  USERKlND=NORMAL)  AND  ( DFKIND=UNTYPEDFILE)  )  ) 

1585  0  42:6  109  THEN 

1536  0  42:7  112  IF  (LENGTH(DVID)  >  0)  AND  ( LENGTH( DVID )  <=  VIDLENG)  AND 

1587  0  ^^2:7  127  (DNUMFILES  >=  0)  AND  (DNUMFILES  <=  MAXDIR)  THEN 

1586  0  42:8  141  BEGIN  OK  :=  TRUE;  (*S0  FAR  SO  GOOD*) 
1389  0  '♦2:9  144  IF  DVID  <>  UVID  THEN 

1590  0  1+2:0  152  BEGIN  (*NEW  VOLUME  IN  UNIT.  ..  CAREFUL* ) 

1391  0  '+2:1  152  LINX  :=  i; 

1392  0  1+2:1  155  WHILE  LINX  <=  DNUMFILES  DO 
1395  0  42:2  162  WITH  GDIRP-^CLINX 3  DO 

1394  0  42:3  169  IF  (LENGTH(DTID)  <=  0)  OR 

1395  0  '^2:3  176  t      "NGTHCDTIO)  >  TIDLENG)  OR 


^1^7  ^  li:'^  !.^'^  (DLAST3LK  <  DFIRSTBLK)  OR 

1393  "  :;:^,  ]ti  (DLASTBYTE  >  FBLKSIZE)  OR 

i?q^  r  lo'.z  (DLASTBYTE  <=  0)  OR 

1400  0  ll'-t  ??s  (DACCESS.YEAR  >=  lOO)  THEN 

1^01  0  llll  III  -  ^-^^^  °*^  '^    FALSE;  DELENTRY(LINX,GDIRP)  END 

\lal  n  !!?•'?  ^''  '^'l^x    :=  LINX  +  i; 

nil  n  u?.*?  ox^  ^^^'^^'^    **'''^5^    ""^^^    SEEN    CHANGED. ..WRITEIT*) 

li^nA  n  uo'i  i^  LINITWRITE(FUNIT,GDIRP-, 

I'^O?  0  l?'l  5^1  (DNUMFlLES  +  l)*SlZEOF(DlRENTRY)tDIRBLK); 

i.SI  0  JL'a  253  end'  ^^  '°''''  =  ''°'''°' 

1409  0  ^+2:0  257  FND 

I'flO  0  42:8  257  END; 

1|+11  0  42:6  257  IF  OK  THEN 

laJ^  n  Uoil  5!2  ^^'^^'^  ^^^^  •=  "^V^^'  UEOVBLK  :=  DEOVBLK; 

1413  0  42.8  272  TIME ( HNOW , DLOAOTIME ) 

X414  0  42:7  279  END 

1415  0  42:5  279  END; 

1416  0  42:3  279        FEtcHDIR  :=  OK; 

1417  0  42:3  282        IF  NOT  OK  THEN 

^aJo  2  !*^*'^  ^^^       ^^^^^   u^i°  :=  •';  UEOVBLK  :=  mmaxint; 

1419  0  42:5  299  RELEASE(GDIRP) ;  GDIRP  :=  NIL 

1420  0  42:4  307  END 

1421  0  42:2  309      END 

1422  0  42:0  309  END  (♦FETCHDiR*)  ; 

1423  0  42:0  328 

1424  0  31:D      1  PROCEDURE  WRITEDIR ( *FUNIT:  UNITNUM;  FDIR:  DIRP*); 

,uo;  n  ^J*°      ^    ^'^^  HNOWtLNOW:  INTEGER;  OK:  BOOLEAN;  LDE:  DIRENTRY! 

14^6  0  3l:0      0  BEGIN 

1427  0  3i:i      0    WITH  UnITABLECFUNIt3.FDIR^C 03  DO 

tuPn  5  l^'^  ^"^      ^^^^^  °^    •=  ^"^^ID  =  DVI°>  ^^^    ((DFKIND  =  UNTYPEDFILE)  OR 

tu^n  ?  i^'.i  ^^  (DFKIND  =  SECUREDIR)); 

143J  0  31 :3     i+i+        IF  OK  THEN 

nil  '^  ^^'"^     ^^  3EGIN  TIME(HNOW,LNOW); 

;lzl  J  mi  53  OK  :=  (LNQW-ULOADTIME  <=  AGELIMIT)  AND 

1;lt^  T  ii  ^^  ((LNOW-DLOADTIME)  >=  0)  AND 

Ta^-  -,  i:'^        ^^  syscom-.miscinfo.hasclock; 

1433  0  3l:o     83  IF  NOT  OK  THEN 

143o  0  3l:s     37  3EGIN  I *m    CLOCK  OR  TOO  OLD*) 
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T  i~      TO 


.^ISULT    =    ORj(  r^jOL'<^UR)     TM^i 


jK     :-    DVID    =    lDl.jVID; 

IF    OK    THLiM 

dcGirNl     (*wE    GUESS    ALL    IS    SAFE ,  .  .  WRITEIT* ) 

DFIRSTBLK    :=    05  (*DIRTY    FIX    FOR    YALOE    BUGS*) 

UiaTwRlTE(FUNIT,FDIR'"i 

(DNUMFILES+1)*SIZE0F(DIRENTRY) iDIRBLK) ; 
OK  :=  lORESULT  =  ORD ( INOERRQR ) ; 

IF  DLASTBLK  =  10  THEN  (*R£DUiMDANT  AFTERTHOUGHT*) 
UNITwRlTE(FUNIT.FDIR'^i 

([)NUMFILES  +  1)*SIZE0F(DIRENTRY)  .6)  ; 
IF    OK    THEiM    TIME{HN0W»0L0A0TIME) 
END 

end; 
if  not  ok  then 

3EGIN  UVID  :=  '•;  UEOVBLK  :=  MMAXINT   END 

END 
END  (*WRlT£DlR*)  ♦ 

FUNCTION  V0LSEARCH(*VAR  FVID:  VXD;  LOQKHARD:  BOOLEAN;  VAR  FDIR:  DIRP*); 

VAR  lusmit:  unitnum;  OKtpHYSUNiT:  boolean;  HNOWtLNOw;  integer; 
BEGIN  volsearch  :=  0;  FDIR  :=  nil; 
OK  :=  false;  physunit  :=  false; 

IF  LENGTH(FVID)  >  0  THEN 
BEGIN 

IF  (F\/IDC13  =  •**•)  AND  ( LENGTH(FVID)  >  D  THEN 
3EGIN  OK  :=  TRUE; 

LUNIT  :=  0;  HNOw  :=  2; 

REPEAT 

IF  FVIDCHNOW]  IN  DIGITS  THEN 

LUNIT  :=  LUNIT*10+ORD(FVIDCHNOW3)-ORO( 'OM 

ELSE  OK  :=  false; 

HNOW  :=  HNOW+l 
UNTIL  (HNOw  >  LENGTH(F\/ID)  )  OR  NOT  OK; 
PHYSUNIT  :=  OK  AND  (LUNIT  >  0)  AND  (LUNIT  <=  MAXUNIT) 

'■ZU^'i 
IF  NOT  PHYSUNIT  THEN 

BEGIN  OK  :=  FALSE;  LUNIT  :=  MAXUNU; 
REPEAT 
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OK    :=    FVID    =    UNITA8LECLUfvlIT:,U\/ID; 
IF    NOT    OK    THEN    LUNIT    :=    LJNlT-1 
UNTIL    OK    OR     (LUfJiT    =    0) 

END 
end; 
IF    OK    THEN 

IF  unitableclunit3.l)isblkd  then 
with  sysco^'"  do 
begin  ok  :=  false;  (*see  if  gdirp  is  good*) 
if  gdirp  <>  nil  then 
if  fvid  =  gdirp'^c0:.dvid  then 
begin  time(hn0w,ln0w) ; 

ok  :=  lnow-gdirp'^cod.dloadtime  <=  agelimit 
end; 
if  not  ok  then 

BEGIN  OK  :=  PHYSUNIT; 

IF  FETCHDIR(LUNIT)  THEN 
IF  NOT  PHYSUNIT  THEN 

OK  :=  FVID  =  GOIRP'^COa.DVlD 
ELSE 
ELSE 

OK  :=  lORESULT  =  ORD ( INOERROR) ;CRELY  ON  lORESULT  FROM  FETCHDIR3 
END 
END; 
IF  NOT  OK  AND  LOOKHARD  THEN 

BEGIN  LUNIT  :=  MAXUNIT;  (♦CHECK  EACH  DISK  UNIT*) 
REPEAT 

WITH  UNITABLECLUNITD  DO 
IF  UISBLKD  THEN 

IF  FETCHDIR(LUNIT)  THEN 

OK  :=  FVID  =  uvid; 
if  not  ok  then  lunit  :=  lunit-1 
until  ok  or  (lunit  =  0) 

end; 
if  ok  then 
with  unitableclunitd  do 

BEGIN  VOLSEARCH  :=  LUNIT; 

IF  LENGTH(UVID)  >  0  THEN  FVID  :=  UViD; 
IF  UISBLKD  AND  (SYSCOM^. GDIRP  <>  NIL)  THEN 
BEGIN  FDIR  :=  SYSCOM^. GDIRP ; 
TIWIE(HNOW»FDIR'*C0J.DLOADTIME) 
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352 

352    CSI    SYSTlM.A     D 

352    til    SYSTEiVi.B    1 

352 

352  (*♦*****♦*****♦***♦**♦********************♦************************) 

352  (*  *) 

352      (*   COPYRIGHT  (C)  1978  REGEMTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.    *) 

352      (*   PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-     *) 

352      (*   TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE    *) 

352      (*   OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS,  *) 

352      (*  *) 

352      (*************♦*♦********♦♦********♦***********♦♦♦*****************) 

352 

352 

3  FUNCTION  DiRSEARCH{*vAR  ftid:  tid;  findperm:  BOOLEAN;  fdir:  dirp*); 
6   VAR  i:  dirrange;  found:  boolean; 

0  BEGIN  DiRSEARCH  :=  0?  FOUND  :=  FALSE;  I  :=  1; 

9  WHILE  (I  <=  FDIR'^COa.DNUMFlLES)  AND  NOT  FOUND  DO 

22  BEGIN 

22  WITH  FDIR'^CID  OO 

28  IF  DTID  =  FTiD  THEN 

36  IF  FINDPERM  =  ( DACCESS. YEAR  <>  lOO)  THEN 

49  BEGIN  DIRSEARCH  :=  I;  FOUND  :=  TRUE  END; 

55  I  :=  I+l 

56  END 

60  END  (*DlRSEARCH*)  I 
76 

1  PROCEDURE  DElENTRY(*FINX:  DIRRANGE;  FDiR:  DIRP*); 

3   VAR  i:  dirrange; 

0  BEGIN 

0  WITH  FDlR^COa  DO 

6  BEGlNi 

6  FOR  I  ;=  FINX  TO  DNUMFlLES-1  DO 

21  FDlR'^Cin  :=  FDlR'^Cl  +  135 

40  FDiR'^CDNUMFILESDtOTID  :=  "; 

53  dNuMFILES  :=  DNUMFILES-; 


1559  0  '61412  59  EhlD 

1560  0  SiflO  6ti  END  .  (*DElF-NTRY*)     ; 

1561  0  3H:;)  75 

1562  0  35: J  1  PROCEDURE  INSEWTR Y ( *vaR  FENTRY:  OIRENTRY;  FINX:  DIRRANGE;  FDIR:  DIRP*); 

1563  0  3b:D  ^  var  i:  DiRRAr^GE; 

l56^  0  55:o  o  begin 

1565  0  35:i  0  WITH  FDiR'*C03  DO 

1566  0  35:2  6  BEGIN 

1567  0  35:3  6  FOR  I  ;=  DNUMFILES  QOWIMTO  FINX  DO 

1568  0  35:4  19  FDlR":i  +  13  :=  FDIR'^CU; 

1569  0  35:3  38  FDlR'^CFINXD  :=  FENTRY; 

1570  0  35:3  h5  QNUMFILES  :=  QNUMFlLES+1 

1571  0  35:2  51  END 

1572  0  35:o  Stf  END  (*INSENTRY*)  ; 

1573  0  35:o  68 

1574  0  47:D  3  FUNCTION  ENTERTEMP ( VaR  FTID:  TIO;  FSEGS:  INTEGER; 

till  I  '^^•^  5  fkind:  filekind;  fdir:  dirp):  dirrange; 

X576  0  47:D  7  VAR  I .LASTI ,DINX,SINX:  DIRRANGE;  RTIIIsh:  BOOLEAN? 

1577  0  47:0  12  SSEGS:  INTEGER;  LOE:  DIRENTRY; 

1578  0  "+7:0  26 

\lll  S  !*®*°  ^  PROCEDURE  FINDMAX(CURINX:  DIRRANGE;  FIRSTOPEN.NEXTUSED:  INTEGER); 

1580  0  'f8:D  4  VAR  FREEAREA:  INTEGER; 

1581  0  48:o  0  BEGIN 

1582  0  48:i  0  FREEAREA  :=  NEXTUSED-FIRSTOPEN ; 

1583  0  18:1  5  IF  FREEAREA  >  FSEGS  THEN 

1584  0  48:2  10  BE3IN 

1585  0  48:3  10  SINX  :=  DINX;  SSEGS  :=  FSEGS; 

1586  0  '+8:3  16  DINX  :=  CURINX?  FSEGS  :=  FREEAREA 

1587  0  48:2  19  END 

1588  0  48:i  22  ELSE 

1589  0  48:2  24  IF  FREEAREA  >  SSEGS  THEN 

1590  0  48:3  29  BEGIN  SSEGS  ;=  FREEAREA;  SINX  :=  CURINX  END 

1591  0  48:0  35  END  (*FINDNIAX*)  ; 

1592  0  48:o  48 

1593  0  47:0  0  3EGIN  ( *ENTERTEMP* ) 

1594  0  47:i  0  DINX  :=  0;  LASTI  :=  FDIR'^C03. DNUMFILES; 

1595  0  '+7:1  11  SINX  :=  o;  ssegs  :=  o; 

1596  0  '+7:1  17  IF  FSEGS  <=  0  THEN 

1597  0  47:2  22  BEGIN  RTIIISH  :=  FSEGS  <  O; 

1598  0  47:3  27  FOR  I  :=  1  TO  LASTI  DO 

1599  0  47:4  39  FINDMAX  (I ,  FDIR'^C  I-13.DLASTBLK  .FDIR'^C  I  D.DFIRSTBLK)  {                    39 
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IF  RTllISH  THEM 
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i3EGI^^^  FSEGS  *.=  SSEGS;  DINX  :=  SINX  END 

16UH 
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ELSE  FSEGS  :=  (FSEGS+1)  OIV  2 
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END 
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ELSE 
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103 

BEGIN  I  :=  1; 

1608 
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17:3 
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WHILE  I  <=  LASTI  DO 

1609 

0 

i7:i 

111 

JESIN 

1610 

0 

17:5 

111 

IF  FDIR'^CID.DFIRSTBLK-FDIR'^CI-IJ.DLASTBLK  >=  FSEGS  THEr 

1611 

0 

17:6 

128 

BEGIN  DINX  :=  I;  I  :=  LASTI  END; 

1612 

0 

17:5 

131 

I  :=  i+i 

1613 
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i7:i 

135 

END! 

16m 

0 

17:3 
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IF  QINX  =  0  THEN 

1615 

0 

i7:i 

116 

IF  FDIR'^C03,DEOVBLK-FDIR'*CLASTI3,DLASTBLK  >=  FSEGS  THEN 

1616 
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DINX  :=  LASTI+1 

1617 
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end; 

1618 

0 
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IF  LASTI  =  MAXDIR  THEN  DINX  ;=  O; 
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BEGIN 

1621 

0 

17:3 

17^ 

WITH  LDE  DO 
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BEGIN 
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OFIRSTBLK  :=  FDlR'^CDlNX-1  D.DLASTBLK  ; 

1624 

0 
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OLASTBLK  :=  DFIRSTBLK+FSEGS ; 

1625 

0 

17:5 

193 

DFKIND  :=  FKIND;  DTID  :=  FTID; 

1626 

0 
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OLASTBYTE  :=  FBLKSIZE! 
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i^ITH  DACCESS  DO 
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BEGIN  MONTH  :=  o;  DAY  :=  O;  YEAR  :=  100  END 
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END; 
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INSENTRY( LDE ♦ DINX, FDIR) 
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end; 
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entertemp  :=  dinx 

1633 

0 

17:0 

233 

END  (*entertemp*)  ; 
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BEGlv  FSTATE  :=  FJANDw; 

1&41 

0 

516 

3 

ife'+a 

0 

3:3 

13 

1643 

Ci 

3:3 

2b 

1G^^^■ 

0 

3:4 

36 

1645 

0 

3:5 

36 

1646 

0 

3:5 

46 

1647 

0 

3:4 

54 

1648 

0 

3:3 

56 

1649 

0 

3:4 

58 

1650 

0 

3:5 

63 

1651 

0 

3:4 

71 

1652 

0 

3:2 

77 

1653 

0 

3:o 

80 

1654 

0 

3:o 

92 

X655 

0 

49:d 

1 

1656 

0 

49:d 

2 

X657 

0 

f9:o 

0 

1658 

0 

49:i 

0 

1659 

0 

49:2 

3 

1660 

0 

49:3 

6 

1661 

0 

49:3 

18 

1662 

0 

49:4 

22 

1663 

0 

49:5 

31 

1664 

0 

49:5 

41 

1665 

0 

49:6 

46 

1666 

0 

49:7 

46 

1667 

0 

49:7 

52 

1666 

0 

49:3 

58 

1669 

0 

49:9 

67 

1670 

0 

49:o 

76 

1671 

0 

49:7 

86 

1672 

0 

49:8 

91 

1673 

0 

49:9 

101 

1674 

0 

49:o 

104 

1675 

0 

49:9 

120 

1676 

0 

49:9 

129 

1677 

0 

49:9 

141 

1678 

0 

49:9 

150 

1679 

0 

49:o 

157 

1680 

0 

49:i 

166 

1681 

0 

49:i 

176 

FisoPEN  :=  false:;  FcIOf  :=  true; 
feoln  :=  TRUE;  FWiNDOw  :=  window; 

IF  (RECWORDS  =  0)  OR  (RECWORDS  =  -2)  THEN 

3EGIN 

FwiNDOw'^cin  :=  cHR(o);  frecsize  :=  i; 

IF  RECWORDS  =  0  THEN  FSTATE  :=  FNEEDCHftR 
ENO 
ELSE 

IF  RECWORDS  <  0  THEN 

BEGIN  FWINDOW  :=  NIL?  FRECSIZE  :=  0  END 
ELSE  FRECSIZE  :=  RECWORDS+RECWORDS 
END 
END  (*FINIT*)  J 

PROCEDURE  RESETER(VAR  F:FIB); 

VAR  BISGER:  BOOLEAN; 
BEGIN 

WITH  F  DO 

BEGIN  FREPTCNT  :=  0; 

FEOLN  :=  false;  feof  :=  false; 

IF  FISBLKD  THEN 

BEGIN  BISGER  :=  FNXTBLK  >  FMAXBLK; 
IF  BIGGER  THEN  FMAXBLK  :=  FNXTBLKj 
IF  FSOFTBUF  THEN 
BEGIN 

IF  BIGGER  THEN  FMAXBYTE  :=  FNXTBYTE 
ELSE 

IF  FNXTBLK  =  FMAXBLK  THEN 
IF  FNXTBYTE  >  FMAXBYTE  THEN 

BEGIN  BIGGER  :=  TRUE;  FMAXBYTE  :=  FNXTBYTE  END; 
IF  FBUFCHNGD  THEN 

BEGIN  FBUFCHNGD  :=  FALSE;  FMODIFIED  :=  TRUE; 
IF  BIGGER  THEN 

FILLCHAR(FBUFFERCFNXTBYTED,FBLKSlZE-FNXTBYTE.O); 
UNITWRITE(FUNIT,F3UFFER»FBLKSIZE, 

FHEADER.DFIRSTBLK+FNXTBLK-1) ; 
IF  BIGGER  AND  (FHEADER.DFKIND  =  TEXTFILE) 
AND  ODD(FNXTBLK)  THEN 
BEGIN  FMAXBLK  :=  FMAXBLK+1; 

FILLCHAR(FBUFFER,FBLKSlZEiO);  m^ 

UNlTWRlTE(FUNIT,FBUFFERiFBLKSIZEi  ^^ 
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FHEADER.OFIRSTBLK+FNXTBLK) 

LND 

ENLi 
FNXTBYTE  :=  FBLKSIZE 

end; 

FNXT3LK  ;=  0; 

IF  FSOFTBUF  AND  ( FHEADER .DFKIND  =  TEXTFILE)  THEN 
FNXTBLK  :=  2 

END 
END 
END  (*RESETER*)  ; 

PROCEDURE  FOPEN{*VAR  f:  FIB;  VAR  FTITLE:  STRING; 

FOPeNOLD:  BOOLEAN?  JUNK  PARAM*); 
LABEL  l; 

VAR  ldir:  dirp;  lunit:  unitnum;  linx:  DIRRANGE; 
lsegs,nbytes:  integer;  lkino:  filekind? 
qldheap:  '^integer;  swapped:  boolean; 
saverslt:  iorsltwd;  lvid:  vid;  ltid:  tid; 

BEGIN  SYSCOM'^.IORSLT  :=  INOERRORI 
WITH  F  do 

IF  FISOPEN  THEN  SYSCOM'*,  lORSLT  :=  INOTCLOSED 
ELSE 

IF  scantitle{ftitle,lvid»ltid»lsegs.lkind)  then 

BEGIN  (*GOT  AN  OK  TITLE*) 

IF  ORD(FOPENOLD)  >  1  THEN  (*OLD  CODE  SPECIAL  CASE*) 

FOPENOLD  :=  <0RD(F0PEN0LD)  =  2)  OR  ( ORD(FOPENOLD)  =  4); 

SWAPPED  :=  false; 

WITH  SWAPFIB''  DO 

IF  FISOPEN  AND  ( SYSCOM'^.GDIRP  =  NIL)  THEN 
BEGIN  MAKK(OLDHEAP) ; 

NBYTES  :=  ORO(SYSCOM'^.LASTMP)-ORD(OLDHEAP)  ; 
IF  (NBYTES  >  0)  AND  (MBYTES  <  SIZEOF(DIRECTORY) +400)  THEN 
BEGIN 

NBYTES  :=  ORD(OLDHEAP)-ORD(EMPTYHEAP) ; 

IF  (NBYTES  >  0)  AND  (NBYTES  >  SI2E0F (DIRECTORY ) )  AND 

(UNITABLECFUNIT3,U\/ID  =  FVID)  THEN 
BEGIN 

UNITWRITE(FUNIT,EMPTYHEAP'^,  SI  ZEOF(  DIRECTORY)  , 

FHEADER. DFIRSTBLK) ; 
RELEAf   EMPTYHEAP);  SWAPPED  :=  TRUE 
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E'C 


EN3; 
LU!\JIT  :=  VQLSEARCH(LVIO,TRUEfLDIR)  ; 
IF  LUNIT  =  0  THEN  SYSCOM" .  lORSLT  :=  IfMOUNIT 
ELSE 

WITH  UNITAOLECLUNITD  DO 

BEGIN  (*OK.,.0PEN  UP  FILE*) 

FISOPEN  :=  TRUE;  FMODIFIED  :=  FALSE; 

FUNiT  :=  lunit;  fvid  :=  lvid; 

FNXTBLK  :=  O;  FISBLKD  1=  UISBLKD; 
FSOFTBUF  :=  UISBLKD  AND  (FRECSIZE  <> 
IF  (LDIR  <>  NIL)  AND  {LENGTH( LTID )  > 
BEGIN  (*LOOKUP  OR  ENTER  FHEADER  IN 


0); 

0)  THEN 

DIRECTORY*) 


LINK  :=  DIRSEARCH{LTID»F0PEN0LD»LDIR); 
IF  FOPENOLD  THEN 
IF  LINX  =  0  THEN 

BEGIN  SYSCOM'^.IORSLT  :=  INOFILE;  GOTO  1  END 
ELSE  FHEADER  :=  LDIR*CLINX3 
ELSE  (*OPEN  NEW  FILE*) 
IF  LiNX  >  0  THEN 

BEGIN  SYSCOM'^.IORSLT  :=  IDUPFILEJ  GOTO  1  END 
ELSE 

BEGIN  (*MAKE  A  TEMP  ENTRY*) 

IF  LKIND  =  UNTYPEDFILE  THEN  LKIND  :=  DATAFILE; 
LINX  :=  ENTERTEMP{LTID,LSEGS»LKIND»LDIR); 
IF  (LINX  >  0)  AND  (LKIND  =  TEXTFILE)  THEN 
WITH  LDIR'^CLINX]  DO 
BEGIN 

IF  ODD(DLASTBLK-DFIRSTBLK)  THEN 

DLASTBLK  :=  DLASTBLK-i; 
IF  DLASTBLK-DFIRSTBLK  <  4  THEN 

BEGIN  DELENTRY(LINXfLDIR);  LINX  :=  0  END 
END; 
IF  LINX  =  0  THEN 

BEGIN  SYSCOM'^.IORSLT 
FHEADER  :=  LDIR'^CLINXD; 
WRITEDIR(LUNIT,LDIR) 
END 
EMD 
ELSE  (♦FHEADER  MOT  IN  DIRECTORY*) 


:=  INOROOM; 
FMODIFIED 


GOTO  1  end; 

:=  TRUE; 
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BtlGiN 

IF  FOPENOLD 
BEGIN 

SYSCOfJl'* 
GOTO  15 
END; 
WITH  FHEADE 
BEGIN  (*D 
DFIRST3 
IF  UIS3 
DFKIND 
DLASTBY 
WITH  DA 
BEGIN 
END;  COF 
end;   COF  E 
IF  FOPENOLO  THE 
FMAXBLK  :=  FN 
ELSE  FMAXBLK  := 
IF  FSOFTBUF  THE 
BEGIN 

FNXTBYTE  := 

IF  FOPENOLD 

ELSE  FMAXBY 

WITH  FHEADE 

IF  DFKIND 

BEGIN  F 

IF  NO 

BEG 

F 

U 

U 

END 

END 

END  5 
IF  FOPENOLD  THE 

ELSE  Rfc.SETER(F) 

IF  syscow^.iors 

BEGIN  FISOPEN 

end; 
swapped  then 


AND  ( LENGTH (LTID)  <>  0)  THEN 

.lORSLT  :=  inofile; 


;=  O;  DLASTBLK 
THEN  DLASTBLK 
.KIND;  DTID  : 
;=  FBLKSI2E; 
5S  DO 

JTH  :=  O;  DAY 
13 


i=  MMAXINT* 
:=  UEOVBLK; 


=  •  • 


;=  o;  YEAR  :=  o  end 


R  DO 

IRECT  UNIT  OPENt  SET  UP  DUMMY  FHEADER*) 

LK 
LKD 

:=  Lf 

TE 

ccEs; 

WON' 
WITH 
LSED 

EADER.DLASTBLK-FHEADER.DFIRSTBLK 

o; 

N 

FBLKSIZE;  FBUFCHNGD  :=  FALSE; 

THEN  FMAXBYTE  :=  FHEADER, DLASTBYTE 
TE  :=  FBLKSIZE; 
R  DO 

=  TEXTFILE  THEN 
NXTBLK  :=  2; 
T  FOPENOLD  THEN 

IN  (*NEW  .TEXTi  PUT  NULLS  IN  FIRST  PAGE*) 
ILLCHAR(FBUFFER»SIZE0F(FBUFFER) lO) ; 
MI TWRITE(FUNIT»FBUFFER, FBLKSIZE I DFIRSTBLK) ; 
NITWRITE(FUNITtFBUFFER, FBLKSIZE *DFIRSTBLK+1) 


N  FRESET(F) 
;  (*N0  GET!*) 
LT  <>  INOERROR  THEN 
:=  FALSE;  FEOF  :=  TRUE? 


FEOLN  :=  TRUE  END 


^^^5  0  b:6  657  BEGIN  RELEASE ( OLDHEAP ) ;  SYSCOM". GDIRP  :=  NIL! 

120^  f^  5:7  693  SAVERSLT  :=  SYSCOM'^ ,  lORSLT ; 

1807  0  5:7  704  UNITREA0(SWAPFI3'*.FUNIT,EMPTYHEAP''.SIZE0F{DIRECT0RY)  t 

1808  0  5:7  715  SwAPFIB'*  .FHEADER.DFIRSTBLK )  ; 
13Q9  0  5:7  725  SYSCOM^.IORSLT  :=  SAVERSLT 

1810  0  5:6  726  END 

1811  0  5:4  728  rr.-D 

1812  C  5:3  728  ELSE  SYSCOM'^.  lORSLT  :=  IBADTITLE 

1813  0  5:0  733  END  (*FOpeN*)  ! 
18m  0  5:0  758 

1815  0  6:D  1  PROCEDURE  FCLOSE(*VAR  F:  FIB!  FTYPE:  CLOSETYPE*); 

1816  0  6:d  3  LABEL  1; 

1817  0  6:D  3  VAR  LINX.DUPINX:  DIRRANGE;  LDIR:  DIRPi  FOUND:  BOOLEAN; 

1818  0  6:0  0  BEGIN  SYSCOW^. lORSLT  :=  INOERROR; 

1819  0  6:i  5  WITH  F  DO 

1820  0  6:2  8  IF  FISOPEN  AND  (FWINDOW  <>  SYSTERWI^.FWINDOW)  THEN 

1821  0  6:3  20  BEGIN 

1822  0  6:*+  20  IF  FISBLKD  THEN 

1823  0  6:5  2'+  WITH  FHEADER  DO 

182^  0  6:6  29  IF  LENGTH(DTID)  >  0  THEN 

1825  0  6:7  38  BEGIN  (*FILE  IN  A  DISK  DIRECTORY. . .FIXUP  MAYBE*) 

1826  0  6:a  38  IF  FTYPE  =  CCRUNCH  THEN 

1827  0  6:9  <+3  BEGIN  FMAXBLK  :=  FNXTBLK; 

1828  0  6:0  50  DACCESS.YEAR  :=  100;  FTYPE  :=  CLOCK; 

1829  0  6:0  50  IF  FSOFTBUF  THEN  FMAXBYTE  :=  FNXTBYTE 

1830  0  6:9  68  END; 

1831  0  6:8  72  RESETER(F); 

1832  0  6:a  75  IF  FMODIFIED  OR  ( DACCESS, YEAR  =  lOO)  OR  (FTYPE  =  CPURGE)  THEN 

1833  0  6:9  93  BEGIN  (icHAVE  TO  CHANGE  DIRECTORY  ENTRY*) 
IBS'*  0  6:0  93  IF  FUNIT  <>  V0LSEARCH(FVID»FALSE,LDIR)  THEN 

1835  0  6:i  108  BEGIN  SYSCOW^, IORSlT  1=  ILOSTUNIT;  GOTO  1  END? 

1836  0  6:0  115  LINX  :=  1;  FOUND  :=  FALSE; 

1837  0  6:0  121  WHILE  (LINX  <=  LDIR'^C  03.DNUMFILES)  AND  NOT  FOUND  DO 

1838  0  6:i  134  BEGIN  (*L00K  FOR  FIRST  BLOCK  MATCH*) 

1839  0  6:2  134  FOUND  :=  (LDIR^CLINXD.DFlRSTBLK  =  DFIRSTBLK)  AND 

1840  0  6:2  142  ( LOIR'^C  LINX3.DLASTBLK  =  DLASTBLK); 

1841  0  5:2  153  LINX  :=  LINX  +  1 

1842  0  6:i  154  END; 

1843  0  6:0  150  IF  NOT  FOUND  THEN 

1844  0  6:l  164  BEGIN  SYSCOM*.  lORSLT  :=  ILOSTFILE;  GOTO  1  END;          *■:- 

1845  0  6:0  171  LINX  :=  LiNX  -  i;  (*CORRECT  OVERRUN*)                     ^'^ 
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IF  ((FTYPE  =  CfJOKMAL)  AND  (  LDIR"!:  LiNX  3.  DACCESS .  YEAR  =  100)) 
OR  (FTYPE  =  CPURGE)  THEN 
DELENTRY(LirNiX»LOlR)   {*2AP  FILE  OUT  OF  EXISTANCE*) 
ELSE 

BEGIN  {*^ELL...LOCK  IN  A  PERM  DIR  ENTRY*) 
UUPINX  :=  OIRSEARCH(DTID,TRUE,LDIR) ; 
IF  (uUPINX  0  0)  AND  (DUPINX  <>  LINX)  THEN 

BEGIN  (*A  DUPLICATE  PERM  ENTRY. ..ZAP  OLD  ONE*) 
DEL£NTRY<DUPINX,LDIR) ; 
IF  DUPINX  <  LINX  THEN  LINX  :=  LINX-1 
END; 
IF  LDIR'^CLINX3.DACCESS.YEAR  =  100  tHEN 
IF  DACCESS.YEAR  =  100  THEN 

DACCESS  :=  THEDATE 
ELSE  {*LEAVE  ALONE. . .FILER  SPECIAL  CASE*) 
ELSE 

IF  FMOOIFIED  AND  { THEDATE. MONTH  <>  0)  THEN 

DACCESS  :=  THEDATE 
ELSE 

DACCESS  :=  LDIR'^CLINXJ. DACCESS; 
DLASTBLK  :=  DFIRSTBLK+FMAXBLK ; 
IF  FSOFTBUF  THEN  DLASTBYTE  :=  FMAXBYTE; 
FHEADER.FILLERl  :=  0\       CTHIS  HAD  BETTER  WORK,  STEVED 
FMODIFIED  :=  false;  LDIR^CLINXD  :=  FHEADER 
END; 
WRlTEDlR(FUNITfLDIR) 
END 
END; 
IF  FTYPE  =  CPURGE  THEN 

IF  LENGTH(FHEADER.DTID)  =  0  THEN 
UNITABLECFUNIT3.UVID  :=  ••; 
FEOF  :=  TRUE;  FEOLN  :=  TRUE;  FISOPEN  :=  FALSE 
END; 
(*fclose*)  ; 
system. b  d 

SYSTEM. C  3 

(*******♦*****************♦♦***♦♦♦♦**♦****♦♦♦♦♦*♦*♦♦*♦**♦♦♦**♦♦♦♦*♦) 

{*  *) 

(♦   COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.    *) 
(*   PERMISSION  TO  COPY  OR   "STRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-     ♦l^ 


1887    0  fe-n  lot  !*   ^'^I^^'^  ^f'  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  tJRiTTEN  LICENSF    *, 

i8d3    0  l':t  lli  \l       OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS.           V) 

1890    0  t\i  l^  *******************************************************************^ 

nil         I  ^:g  ;^22  (*  INPUT-OUTPUT  PRLviiTIVES  *) 

nil         I  III  0    SYSCO.^^.XEQERR  :=  ,i;    C  NOT  I.P  ERR  D 

Jfol    ^  ^•'^  "^  END  (*XSEEK*)  ; 

1898    0  9:o  22 

Jlon    S  J!:?  ^  PROCEDURE  XReaDREAL; 

1900    0  l«+:o  0  BEGIN 

}qS^   «  ^  '^  ^  E'^^  (♦xReaoreal*)  ; 

190'+    0  1110  22 

"SI  ?  llil  ?        3rSC0«-.XEQERR    :=    Ui    C    NOT    IHP   ERR    3 

ino  S  "IS  al   ''°    '*XWRITEREAL.)    i 

i«2  0°  50°;°  '    F^JTION^CANTSTRETCH.VAR    P:    FIB.!    BOOLEAN!    (.REPLACED   Br   RJH   a«AR78.. 

E  0°'  lis  I  ^""  cA.isrS^?r?i'T^SETiK^;=%^i^r  """^^^"=  '"^""'  ^""^  "«^' 

JgJ^  S  ^S*^  ^         ^^TH    F,FHEADER    DO 

llll  S  ^nix  i^      ^^  LENGTH(DTID)  >  0  THEN 

1919  0  In'u  ol  ^^^^^    ^*^^    '^    DIRECTORY  FOR  SURE*) 

1920  0  50*5  fa  ^^  o^J'^r^'^    ^>  VQLSEARCH  ( FVID, FALSE,  LDIR )  THEN 

1923  0  50:5  II                         "'^BEGIn''^'^^  ^"^    LDIR-C  0  D.DNUMFILES )  AND  NOT  FOUND  DO 

1925  S  lilt  72  ''°^''°  •=  ;[-°JR'^CLlNX].DFIRSTBLK  =  DFIRSTBLK)  AND 

1926  0  ,o':l  II  ,,,,    ^^  J^0IR^CLINX,.DLASTBLK  =  DLASTBLK,,                        ^ 
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50 
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50 
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50 

50: 

50 
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50; 

50: 
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50 
50 

50: 
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50 
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50; 
50; 
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41 

4: 
4: 
4: 
4: 
4: 
4: 
4: 
4: 
4: 
1 

28; 

28; 

28: 
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90 

94 
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111 

115 

127 

141 
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149 

149 

161 

166 

174 
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184 

195 

207 

214 

217 

220 
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224 

234 
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5 
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35 
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3 

9 
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IF  NOT  FOUfJ 

jEGIN  SYS 

IF  LirJX  >  L 

LAVAILBLK 

cILSE  LAVAIL 

IF  (DLASTBL 

BEGIN 

-^IITH  LD 

BEGIN 

OLA 

WRI 

IF 

end; 
FEOF  := 
IF  FSTA 
DLASTBL 
DACCESS 
END; 

OK  :=  true; 

END; 
i:   IF  NOT  OK  THEN 

BEGIN  F.FEOF 
END  (*CANTSTRETCH*) 


D  THEN 

COM'.IORSLT  :=  ILOSTFILE;  GOTO  1  END; 
OIR'^COJ.DNUMFIlES  THEN 
:=  LDIR''C0:.DE0\/BLK 

3LK  :=  ldir'Clinxd.dfirstblk; 

k  <  lavailblk)  or  (olastbyte  <  fblksi2e)  then 

ir'^clinx-i]  do 

stblk  :=  lavailblk;  olastbyte  :=  fblksi2e; 

tedir(funitiLdir) ; 

lORESULT  <>  ORD(INOERROR)  THEN  GOTO  1 

FALSE;  FEOLN  :=  FALSE; 
TE  <>  FJANOW  THEN  FSTATE  :=  FNEEDCHAR;  (*RJH  2MAR78*) 
K  :=  LAVAILBLK;  OLASTBYTE  :=  FBLKSIZE; 
•YEAR  :=  100;  CANTSTRETCH  :=  FALSE 


:=  true;  f.feoln  :=  true  end 


procedure  freset(*var  f:  fib*); 
BEGIN  syscom'^.iorslt  :=  inoerror; 

WITH  F  DO 

IF  FISOPEN  THEN 

BEGIN  RESETER(F) 5 

IF  FRECSIZE  >  0  THEN 

IF  FSTATE  =  FJANDW  THEN  FGET(F) 
ELSE  FSTATE  :=  FNEEDCHAR 
END 
END  (*FRESET*)  ; 

FUNCTION  f3L0CKI0(*VAR  F:  FIB;  VAR  A:  WINDOW;  I:  INTEGER; 

NBLOCKStRBLOCK:  INTEGER;  DQREAD:  BOOLEAN*); 

3EGIN  FBLOCKio  :=  0;  sYscow'.iORSLT  :=  inoerror; 

WITH  F  00 

IF  FISOPEN  AND  (NBLOCKS  >(       )    THEN 
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X981 

1982 

1983 

1984 

1985 

1986 

1987 

1988 

1989 

1990 

1991 

1992 

1993 

199t 

1995 

1996 

1997 

1998 

1999 

2000 

2001 

2002 

2003 

2004 

2005 

2006 

2007 

2008 


0 
0 

0 
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28; 
28: 
28: 
28; 


28:6 


19 
21 
23 
28 
38 
4^+ 
52 
56 
63 
71 
77 
85 
90 
90 
93 
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126 
126 
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166 
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187 
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208 
211 
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235 
248 
251 
255 
258 


IF  FIS3LK0  THEfj 
^ITH  FHEADER  DO 
BE3Ifvl 

IF  RBLOCK  <  0  THEN  R3L0CK  :=  FNXTBLK; 

R6L0CK  :=  ofirstblk+rblock; 

IF  RBLOCK+NBLOCKS  >  DLAST3LK  THEN 

IF  NOT  DOREAD  THEM 

IF  CANTSTRETCH(  F  )  THEN; 
IF  RBLOCK+NBLOCKS  >  0LAST3LK  THEN 

NBLOCKS  :=  DLASTBLK-RBLOCK; 

FEOF  :=  RBLOCK  >=  dlastblk; 

IF  NOT  FEOF  THEN 
BEGIN 

IF  DOREAD  THEN 

UNlTREAD(FUNlT,ACI3tNBL0CKS*FBLKSIZE»RBL0CK) 
ELSE 

BEGIN  FMODIFIED  :=  TRUE? 

UNlTWRlTE(FUNIT,ACI3,NBL0CKS*FBLKSlZEfRBL0CK) 
END! 
FBLOCKIO  :=  NBLOCKS; 
RBLOCK  :=  RBLOCK+NBLOCKS; 
FEOF  :=  RBLOCK  =  DLASTBLKJ 
FNXTBLK  :=  RBLOCK-DFIRSTbLKI 

IF  FNXTBLK  >  FMAXBLK  THEN  FMAXBLK  :=  FNXTBLK 
END 
END 
ELSE 

BEGIN  FBLOCKIO  :=  NBLOCKS; 
IF  DOREAD  THEN 

UNITREAD(FUNITiACl3.NaL0CKS*FBLKSIZE,RBL0CK) 
ELSE 

UNITWRITE<FUNIT,ACI3,NBL0CKS*FBLKSIZE»RBL0CK); 
IF  lORESULT  =  ORDdNOERROR)  THEN 
IF  DOREAD  THEN 

BEGIN  RBLOCK  :=  NBLOCKS*FBLKSIZE ; 

RBLOCK  :=  RBLOCK+SCAN{-RBLOCK«<>CHR(0)tACI+RBLOCK-13) J 
RBLOCK  :=  (RBLOCK+FBLKSlZE-1)  DIV  FBLKSIZE; 
FBLOCKIO  :=  RBLOCK; 
FEOF  :=  RBLOCK  <  NBLOCKS 
END 
ELSE 
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2026 
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0 
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0 
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7:2 

169 
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0 
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189 

LLSE  FBLOCKIU  :=  0 

Zip 
ELSE 

SYSCO'^".IO«SLT    :=    Ir-JOTOPEM 
END    {*FBlOCKIO*)     5 

PROCEDURE  FGET(*VAR  f:  FIB*)? 

LABEL  1,  2;  ,    „ 

VAR  LEFTOGETiWININXiLEFTlNBUF. amount:  INTEGER. 

done:  boolean; 
begin  syscom'^.iorslt  :=  inoerror; 

WITH  F  DO 

IF  FISOPEN  THEN 
BEGIN 

IF  FREPTCNT  >  Q  THEN 

BEGIN  FREPTCNT  :=  FREPTCNT-l?  IF  FREPTCNT  >  0  THEN  GOTO  2  END  J 
IF  FSOFTBUF  THEN 
WITH  FHEAOER  do 
BEGIN 

leftoget  :=  frecsize;  wininx  :=  oj 

REPEAT 

IF  FNXTBLK  =  FMAXBLK  THEN 

IF  FNXTBYTE+LEFTOGET  >  FMAXBYTE  THEN  GOTO  1 

ELSE  LEFTINBUF  :=  DLASTBYTE-FNXTBYTE 
ELSE  LEFTINBUF  :=  FBLKSIZE-FNXTBYTE ; 
AMOUNT  :=  LEFTOGET; 

IF  AMOUNT  >  LEFTINBUF  THEN  AMOUNT  :=  LEFTINBUF? 
IF  AMOUNT  >  0  THEN 

BEGIN 

MOVELEFTCFBUFFERCFNXTBYTEltFWlNDOW^CWININXDfAMOUNT) J 

FNXTBYTE  :=  FNXTBYTE+AMOUNT ; 

wiNiNx  :=  wininx+amount; 

LEFTOGET  :=  LEFTOGET-AMOUNT 

end; 
done  :=  leftoget  =  o; 

if  not  done  then 

BEGIN 

IF  FBUFCHNGD  THEN 

BEGIN  FBUFCHNGD  :=  FALSE;  FMODIFIED  :=  TRUE; 

UNlTWRlTE(FUNlT«FBUFFER»FBLKSlZEfDFIRSTBLK+FNXTBLK-l) 

END; 
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7:o 

197 
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0 
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0 
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0 
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7:6 
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7:5 

261 

2062 

0 

7:4 

261 

I 

2063 

0 

7:5 

267 
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7:7 
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7:8 
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2070 

0 

7:a 

322 

2071 

0 

7:9 

331 

2072 

0 

7:o 

331 

2073 

0 

7:0 

336 

2074 

0 

7:0 

341 

2075 

0 

7:9 

343 

2076 

0 

7:3 

343 

2077 

0 

7:7 

344 

2078 

0 

7:6 

346 

2079 

0 

111 

354 

2080 

0 

7:8 

354 

2081 

0 

7:9 

368 

2082 

0 

7:0 

368 

2083 

0 

7:0 

382 

2084 

0 

7:9 

390 

2085 

0 

7:a 

392 

2086 

0 

7:9 

394 

2087 

0 

7:7 

401 

2088 

0 

7:5 

401 

2089 

0 

7:3 

401 

END 

2090 

0 

7:2 

401 

ELSE 

IF  lORESULT  0  ORD(INOERROR)  THEN  GOTO  l; 
tMlTREAD(FUMIT.FBUFFERiFBLKSlZE»DFlRSTBLK+FNXTBLK) 
IF  lORESULT  <>  ORD(IMQERROR)  THEN  GOTO  l; 
FNXTBLK  :=  FrJXTBLK  +  1;  FNXTBYTE  :=  0 
EMD 
UNTIL  GONE 
EMD 
ELSE 
dEGIN 

UNITREAOcFUNITiFWINDOW^.FRECSlZE) ; 
IF  lORESULT  0  ORD(INOERROR)  THEN  GOTO  1 
END; 

FRECSIZE  =  1  THEN  (*FILE  OF  CHAR*) 
BEGIN  FEOLN  :=  FALSE; 

IF  FSTATE  <>  FJANDW  THEN  FSTATE  :=  FGOTCHAR; 
IF  FWINOoW'CO:  =  CHR(EOL)  THEN 

BEGIN  FWINDOWCO:  :=  •  M  FEOLN  :=  TRUE!  GOTO  2  END; 
IF  FWINDOW"C03  =  CHR(DLE)  THEN 
BEGIN  FGET(F) ; 

AMOUNT  :=  ORDCFWINDOW^CO^j-Sa; 
IF  (AMOUNT  >  0)  AND  (AMOUNT  <=  127)  THEN 
BEGIN 

FWiNDowcoD  :=  •  •; 
FREPTCNT  :=  amount; 

GOTO  2 

end; 

FGET(F) 

end; 
if  fwindowcod  =  chr(o)  then 
begin  {*lof  handling*) 

IF  FSOFTBUF  AND  ( FHEADER.DFKIND  =  TEXTFILE)  THEN 
BEGIN  (*END  OF  2  BLOCK  PAGE*) 

IF  0DD(FNXT3LK)  THEN  FNXTBLK  :=  FNXTBLK+1; 
FNXTBYTE  :=  FBLKSIZE;  FGET(F) 
END 
ELSE 


BEGIN  FiJlNDOW^CO:  :=  •  •;  GOTO  1  END 


END 


END 


51 


5^ 


2091  3  7:3  4-J3  ^E-^IN 

2092  G  7:4-  t+r'^  sysco:^^'"  .  iorslt  :=  inotopln; 

2093  Q  7:'t  Ij.-l  i:  FEOF  :=  TRUE;  FlOlN  :=  TRUE 
209*+  a  7:3  '41b  E^O; 

2095  0  7:i  418  2'. 

209o  0  7:0  413  END  (♦FGET*)  ; 

2097  0  7:0  442 

2093  0  8:0  i  PROCEDURE  FPUT(*VAR  f:  FIB*)! 

2099  0  8:D  2    LAdEL  1; 

2100  0  8:D  2    VAR  LEFTOPUT , WININX i LEFTINBUF » AMOUNT  I  INTESER; 

2101  0  8:j  6  done:  300l.EAN; 

2102  0  8:0  0  QEGIN    SYSCOM".  lORSLT  1=  IiMOERROR; 

2103  0  8:i  5    WITH  F  DO 

2104  0  6:2  6  IF  FisOPEN  THEN 

2105  0  8:3  12  3EGIN 

2106  0  8:4  12  IF  FS0FT8UF  THEN 

2107  0  8:5  17  WITH  FHEADER  DO 

2108  0  8:&  22  BEGIN 

2109  0  8:7  22  LEFTOPuT  :=  FRECSIZE;  WININX  :=  05 

2110  0  8:7  29  REPEAT 

2111  0  8:8  29  IF  DFIRSTBLK+FNXTBLK  =  DLASTBLK  THEN 

2112  0  8:9  40  IF  FNXTBYTE+LEFTOPUT  >  OLASTBYTE  THEN 

2113  0  8:0  51  IF  CANTSTRETCH(  F  )  THEN 

2114  0  8:i  53  BEGIN  SYSCOM'^.  lORSLT  :=  INORGOM;  GOTO  1  END 

2115  0  8:0  65  ELSE  LEFTIN3UF  :=  FBLKSIZE-FNXTBYTE 

2116  0  8:9  70  ELSE  LEFTINBUF  :=  OLASTBYTE-FNXTBYTE 

2117  0  8:3  81  ELSE  LEFTINBUF  :=  FBLKSIZE-FNXTBYTE J 

2118  0  8:8  98  AMOUNT  :=  LEFTOPUT; 

2119  0  8:8  101  IF  AMOUNT  >  LEFTINBUF  THEN  AMOUNT  :=  LEFTINBUF; 

2120  0  8:8  109  IF  AMOUNT  >  0  THEN 

2121  0  8:9  114  BEGIN  FBUFCHNGD  :=  TRUE; 

2122  0  8:o  119  M0VELEFT(FWIND0W'^CWININX3»FBUFFERCFNXTBYTE:»AM0UNT)  ; 

2123  0  8:0  131  fnxtbyte  :=  fnxtbyte+amount; 

2124  0  8:o  140  WiNINX  :=  WININX+AMOUNT ; 

2125  0  8:a  145  LEFTOPUT  :=  LEFTOPUT-AMOUNT 

2126  0  8:9  146  END; 

2127  0  8:6  150  DONE  :=  LEFTOPUT  =  O; 

2128  3  8:8  155  IF  NOT  DONE  THEN 

2129  0  8:9  159  BEGIN 

2130  0  8:0  159  IF  FBUFCHNGD  THEN 

2131  0  8:i  164  BEGIN  Ff^  'CHNGD  :=  FALSE;  FMODIFIED  :=  TRUE; 
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0 

s:2 

174 

2133 

6:i 

194 

213^ 

u 

5:j 

194 

2135 

0 

5:o 

2G2 

213b 

0 

8:i 

211 

2137 

0 

a;o 

229 

2138 

0 

8:i 

231 

2139 

0 

8:o 

241 

2140 

0 

8:o 

249 

21^+1 

0 

8:9 

2bi 

2142 

0 

8:7 

263 

2143 

0 

8:7 

266 

2144 

0 

8:8 

272 

2145 

0 

8:9 

280 

2146 

0 

8:o 

290 

2147 

0 

8:i 

306 

2148 

0 

8:2 

306 

2149 

0 

8:2 

315 

2150 

0 

8:2 

320 

2151 

0 

8:1 

321 

2152 

0 

8:6 

323 

2153 

0 

8:4 

323 

2154 

0 

8:5 

325 

2155 

0 

8:6 

325 

2156 

0 

8:6 

336 

2157 

0 

8:5 

344 

2158 

0 

8:3 

344 

2159 

0 

8:2 

344 

2160 

0 

8:3 

346 

2161 

0 

8:4 

346 

2162 

0 

8:4 

351 

2163 

0 

8:3 

359 

2164 

0 

8:0 

361 

2165 

0 

8:0 

382 

2166 

0 

io:d 

3 

2167 

0 

10:0 

0 

2168 

0 

10:0 

16 

2169 

0 

10:0 

16 

2170 

0 

10:0 

16 

2171 

0 

ii:d 

3 

2172 

0 

11:0 

0 

UlNjITWRlTE(FUNIT,FBUFFERiFBLKSIZE,DFIRSTBLK  +  FNXTBLK-l) 
END; 

IF  lORESULT  <>  ORO(INOERROR)  THEN  GOTO  1; 
IF  FNXTBLK  <  FMAX3LK  THEN 

UNlTREAD(FUNITtFBUFFER,FBLKSI2E,DFIRSTBLK+FNXTBLK) 
ELSE 

FILLCHAR(F3UFFER.FBLKSIZEtCHR(0) ) ; 
IF  lORESULT  0  ORD(INOERROR)  THEN  GOTO  l; 
FNXTBLK  :=  FNXT3LK+1;  FNXTBYTE  :=  0 
END 
UNTIL  DONE; 
IF  FRECSIZE  =  1  THEN 

IF  FWlNDOlfll'^COD  =  CHR(EOL)  THEN 
IF  DFKIND  =  TEXTFILE  THEN 

IF  (FNXTBYTE  >=  F3LKSIZE-127)  AND  NOT  ODD<FNXTBLK)  THEN 
BEGIN 

FNXTBYTE  :=  FBLKSIZE-i; 
FWINOOW^CO]  :=  CHR(O); 
FPUT(F) 
END 

END 
ELSE 
BEGIN 

UNITWRITEtFUNIT.FWlNOOW^t FRECSIZE) 5 
IF  lORESULT  <>  ORD(INOERROR)  THEN  GOTO  1 
END 
END 
ELSE 
BEGIN 

SYSCOW.IORSLT  :=  INOTOPEN; 
1:       FEOF  :=  TRUE;  FEOLN  :=  TRUE 

END 
END  (♦FPUT*)  ; 

FUNCTION  FEOF(*VAR  F;  FIB*); 
BEGIN  FEoF  :=  F.FEOF  END; 

(*  TEXT  FILE  INTRINSICS  *) 

FUNCTION    FEOLN(*VAR    f:    FIB*);  ,_  i 

BEGIN    FEolN    :=    F. FEOLN    END;  53 
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16 
1    oRCCEDURl    Frt>'viTELN(*\/AR    F:    FIE*); 
0    BEGIN 

0       f.fwinjgw^cod   :=  chr(eol);   fput(F) 

0  ENO  (*FWRITElN*)  ; 
20 

1  PROCEDURE  fwritechar(*var  f:  FI3;  ch:  char;  rlemg:  integer*); 

4    LABEL   1; 

0  3EGIM 

0   with  f  do 

3    if  fisopen  then 

7      if  fsoftbuf  then 

12  3EGIN 

12        while  rleng  >  1  do 

17  begin  fwindow^cq]  :=  '  ';  fput(f); 

25  rleng  :=  rleng-1 

26  end; 

32        fwindow^cod  ?=  chj  fput(f) 

38  END 

40  ELSE 

42  BEGIN 

42  iJHILE  RLENG  >  1  DO 

47  BEGIN  FWlNDOW^COa  :=  •  M 

52  unitwrite{funit,fwind0w*»1); 

62  rleng  :=  rleng-1 

63  end; 

69  fwindow'cod  :=  ch; 

74  UNITWRlTEtFUNIT.FWlNDOW'.l) 

84  END 

84      ELSE  SYSCOM'^.IORSLT  :=  INQTOPEN; 

91  1: 

91  END  (♦FWriTECHAR*)  ; 
108 

1  PROCEDURE  FWRITEINT(*VAR  f:  FIB;  I, RLENG:  INTEGER*); 

4    LABEL  1; 

4    VAR  POT, col:  INTEGER'  CH:  CHAR; 

7      suppressing:  boolean;  s:  stringciod; 

0  3EGIN  col  :=  i; 

3   SCO]  :=  CHR(io);  suppressing  :=  true; 

11    IF  I  <  0  THEN 

16     BEGiM  I  :=  ABS(i);  sci3  '.j     -•;  coL  :=  2; 
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u 

li:3 

26 

2215 

J 

13:4 

33 

^216 

0 

13:2 

48 

2217 

0 

I3:i 

43 

2218 

u 

13:2 

59 

2219 

0 

13:3 

72 

2220 

0 

13:3 

83 

2221 

c 

13:4 

35 

2222 

0 

13:5 

83 

2223 

0 

13:5 

98 

2224 

0 

13:4 

110 

2225 

0 

13:2 

114 

2226 

0 

i3:i 

121 

2227 

0 

i3:i 

128 

2228 

0 

13:2 

136 

2229 

0 

i3:i 

142 

2230 

0 

i3:o 

146 

2231 

0 

13: 0 

162 

2232 

0 

19:d 

1 

2233 

0 

19:d 

4 

223H 

0 

i9:o 

0 

2235 

0 

19  ;i 

0 

2236 

0 

19:2 

3 

2237 

0 

19:3 

7 

2238 

0 

19:4 

7 

2239 

0 

19:4 

17 

22'+0 

0 

19:5 

24 

22^1 

0 

19:4 

38 

2242 

0 

19:5 

43 

2243 

0 

19:6 

46 

2244 

0 

19:7 

55 

2245 

0 

19:5 

70 

2246 

0 

19:4 

72 

2247 

0 

19:5 

74 

2248 

0 

19:3 

83 

2249 

0 

19:2 

83 

2250 

0 

i9:o 

88 

2251 

0 

i9:o 

104 

2252 

0 

18:d 

1 

2253 

0 

18:d 

4 

2254 

0 

i8:o 

0 

if  i  =  0  ther\i  (*hardwake  special  case*) 
segin  s  :=  •-32768»;  goto  1  emd 

Ei'Jd; 

FO,^  POT  :=  4  aOWNTO  0  DO 

3egin  ch  :=  chrd  div  ip0tc°0t3  +  ord('om); 
if  (ch  =  'om  ano  (pot  >  0)  and  suppressing  then 
else  (*format  the  char*) 
segifj  suppressing  :=  false; 
sccol:]  :=  chj  col  :=  col+i; 

IF  CH  <>  'O*  then  I  :=  I  MOD  IPOTCPOTD 

END 

end; 

SC03  :=  CHR(COL-l) ; 
i:iF  RLENG  <  LENGTH(S)  THEN 
RLENG  :=  LENGTH(s>  5 

FWRITESTRING(F,S» RLENG) 
END  (*FWRITEINT*)  ; 

PROCEDURE  FWRITESTRING(*VAR  F:  FIB;  VAR  S:  STRING?  RLENG:  INTEGER*); 

BEGIN 

WITH  F  DO 

IF  FISOPEN  THEN 
BEGIN 

IF  RLENG  <=  0  THEN  RLENG  :=  LENGTH(S); 
IF  RLENG  >  LENGTH(S)  THEN 

BEGIN  FWRITECHAR(F.'  • . RLENG-LENGTH( S) ) ;  RLENG  !=  LENGTH(S)  END; 
IF  FSOFTBUF  THEN  .^'.vinioi  limu, 

BEGIN  SINX  :=  1; 

WHILE  (SINX  <=  RLENG)  AND  NOT  FEOF  DO 

BEGIN  FWINDOW^COJ  :r  SCSINX3;  FPUT(F);  SINX  :=  SINX+1  END 

END 
ELSE 

UNITWRITE(FUNIT,SC ID. RLENG) 

END 

ELSE  SYSCOM'^.IORSLT  :=  INOTOPEN 
END  (*FWRITESTRING*)  ; 

PROCEDURE  FREADSTRING(*VAR  F:  FIB;  VAR  S;  STRING;  SLENG:  INTEGER*); 

VAR  SI^JX:  INTEGER;  CH:  CHAR; 
BEGIN  55 


L>o 


2235  0  15 :i      a    WITH  F  00 

^256  0  18:2      3        BE3IN  SINX  :=  i; 

2257  0  la:5    .           -S          IF  FSTATE  =  FNEEIDCHAR  THEN  FGET(F); 

2253  0  18:3  lb          SCOJ  :=  CHR{SLE.rgG)  ;  (*N0  INV  INDEX*) 

2259  0  16:3  19  wHlLC  (SINX  <=  SLENG)  AND  NOT  (FEOLN  OR  FEQF)  DO 

2260  0  18:4  31  BEGIN  CM  :  =  FWINDQW^COD; 

2261  0  18:5  57  IF  FUNIT  =  1  THEN 

2262  0  18:&  43  IF  CHECKDEL { CH t SINX )  THEN 

2263  0  18:6  52  ELSE 

2264  0  18:7  d4  BEGIN  SCSINXD  :=  CH;  SINX  :=  SINX  +  1  END 

2265  0  18:5  63  ELSE 

2266  0  18:6  65  BEGIN  SCSINX3  :=  CH;  SINX  •=  SINX  +  1  END; 

2267  0  18:5  74  FGET(F) 

2268  0  18:4  75  END; 

2269  0  18:3  79  SC03  :=  CHR(SlNX  -  1); 

2270  0  ia:3  85  WHILE  NOT  FEOLN  DO  FGET(F) 

2271  0  18:2  91        END 

2272  0  18:0  95  END  ( *FREADSTRING*)  ; 

2273  0  18:0  112 

2274  0  20:D      1  PROCEDURE  FWRITEBYTES( *VAR  F:  FI3;  VAR  A:  WINDOW;  RLENG.ALENG:  INTEGER*); 

2275  0  20:D      5    VAR  AiNX:  INTEGER; 

2276  0  20:0      0  BEGIN 

2277  0  20;i      0    WITH  F  pO 

2278  0  20:2      3      IF  FISOPEN  THEN 

2279  0  20:3      7        BEGIN 

2280  0  20:4      7  IF  RLENG  >  ALENG  THEN 

2281  0  20:5  12  BEGIN  FWRITECHAR (F» '  ' ♦ RLENG-ALENG) ;  RLENG  :=  ALENG  END; 

2282  0  20:4  22          IF  FSOFTBUF  THEN 
2263  0  20:5  27            BEGIN  AINx  :=  0; 

2284  0  20:6  30  WHILE  (AINX  <  RLENG)  AND  NOT  FEOF  DO 

2285  0  20:7  39  BEGIN  FWlNDOW^COl  :=  ACAINXD;  FPUT(F);  AiNX  1=  AINX+1  END 

2286  0  20:5  54  END 

2287  0  20:4  56  ELSE 

2288  0  20:5  58  UNITWRITE(FUNIT,A,RLENG) 

2289  0  20:3  67        END 

2290  0  20:2  67      ELSE  SYSCOM'^.  IORsLT  :=  INOTOPEN 

2291  0  20:0  72  END  ( *FWRI TE5YTES* )  ; 

2292  0  20:0  83 

2293  0  21:d  1  PROCEDURE  FREADLN(*VaR  F:  FIB*); 

2294  0  21:0  0  BEGIN 

2295  0  ?l:i  0    WHILE  .^JOT  F. FEOLN  qO  FGET(F/ 


£296  a  ^1:1     10    IF  F.FSTATL  =  rjANDw  THEN  F6ET(F) 

2297  u  21:1     17    ELSE 

229B  U  21:2     21      BEGIN  F.FSTATE  :=  FNEEDCHaR;  F.FEOLN  :=  FALSE  END 

2299  0  21:0     31  END  (♦FREADLN*)  ; 

2300  0  21:0     46 

2301  0  16:o      1  PROCEDURE  FREADCHAR ( ♦VAR  fl    FiB;  VAR  CH:  CHAR*); 

2302  0  16:0      0  3EGIN 

2303  0  1611      0    WITH  F  DO 

2304  0  16:2      3        BEGIN  SYSCOM^. lORSLT  :=  INOERRORJ 

2305  0  16:3      8  IF  FSTATE  =  FNEEDCHAR  THEN  FGET{F); 

2306  0  16:3     17  CH  :=  FWINDOWC  0  D ; 

2307  0  16:3     23  IF  FSTATE  =  FJANDW  THEN  FGET(F) 

2308  0  16:3     30  ELSE  FSTATE  :=  FNEEDCHAR 

2309  0  16:2     37        END 

2310  0  16:0     39  END  (♦FREADCHAR* )  ; 

2311  0  16:0     52 

2312  0  12:D      I  PROCEDURE  FREADINT ( *VAR  F:  FIB;  VAR  i:  INTEGER*)! 

2313  0  12:d      3    LABEL  1; 

23m  0  12:D      3    VAR  CH;  CHAR;  NEG,IVALID:  BOOLEAN;  SINx:  INTEGER; 

2315  0  12:0      0  BEGIN 

2316  0  12:1      Q    WITH  F  dO 

2317  0  12:2      3        BEGIN  I  :=  0;  NEG  :=  FALSE;  IVALID  :=  FALSE; 

2318  Q  12:3     12  IF  FSTATE  =  FNEEDCHAR  THEN  FGET(F); 

2319  0  12:3     21  WHILE  (FWINDOWC 0 3  =  •  •)  AND  NOT  FEOF  DO  FGET(F); 

2320  0  12:3     38  IF  FEOF  THEN  GOTO  1; 

2321  0  12:3     44  CH  :=  FWINDOW^CO]; 

2322  0  12:3     50  IF  (CH  =  »+•)  OR  (CH  =  »-•)  THEN 

2323  0  12;4     59  BEGIN  NEG  :=  CH  =  »-»;  FGET(F);  CH  :=  FWINDOW^COD  END; 

2324  0  12:3     73  IF  CH  IN  DIGITS  THEN 

2325  0  12:4     83  BEGIN   IVALID  :=  TRUE;  SiNX  :=  i; 

2326  0  12:5     89  REPEAT 

2327  0  12:6     89  I  :=  I*10  +  ORD{CH)-ORD(»0M; 

2328  0  12:6     99  FGETCF);  CH  1=  FWINDOW'CO 3;  SINX  :=  SINX+l; 

2329  0  12:6  113  IF  FUNIT  =  1  THEN 

2330  0  12:7  119  WHILE  CHEcKDEL ( CH, SINX )  DO 

2331  0  12:8  128  BEGIN 

2332  0  12:9  128  IF  SINX  =  1  THEN  I  :=  0  ELSE  I  :=  I  DIV  10; 

2333  0  12:9  144  FGET(F);  CH  :=  FWINDOWCOD 

2334  0  12:S  150  EiMD 

2335  0  12:5  153  UNTIL  NOT  (CH  IN  DIGITS)  OR  FEOLN  r-> 

2336  0  12:4  164  END;  ^' 


2337  0  12:3  lb'3  IF  IVALIO  OR  FEOF  THEN 

^-533  0  12:*+  175  IF  NEG  THEM  I  :=  -I  ELSE  (*NADA*) 

^^^'^  3  i'^'^  i&"5  £:lse  syscow^.iukslt   :=  iqaoformat 

2340  0  12:2  190  END; 

2341  0  12:1  192  1: 

2342  0  12:0  192  END  (*FREADXNT*)  ; 

2343  0  12:0  212 

2344  0  12:0  212  {*  STRIN5  VARIABLE  INTHINSICS  *) 

2345  0  12:0  212 

2346  0  23:d  1  PROCEDURE  SC0NCAT(*VAR  SRC.DEST:  STRING;  DESTLENg:  INTEGER*); 

2347  0  23:0  0  BEGIN 

2348  0  23:1  0  IF  LENGTH ( SRC ) +LENGTH (DEST)  <=  DESTLENG  THEN 

2349  0  23:2  11  BEGIN 

2350  0  23:3  11  MOVELEFT ( SRCCl 3 tDESTCLENGTH (DEST) +1 D. LENGTH! SRC) ) ; 

2351  0  23:3  24  DESTC03  :=  CHR ( LENGTH( SRC ) +LENGTH( DEST ) ) 

2352  0  23:2  33  END 

2353  0  23:0  34  END  (♦SCqnCAT*)  ; 

2354  0  23:0  46 

2355  0  24:D  1  PROCEDURE  SINSERT{*VAR  SRCfDEST:  STRING;  DESTLENG» INSINX:  INTEGER*)? 

2356  0  24:D  5  VAR  ONRJGHT:  INTEGERS 

2357  0  24:o  0  BEGIN 

2358  0  24:i  0  IF  (INsiNX  >  0)  AND  (LENGTH(SRC)  >  0)  AND 

2359  0  24:i  9  (LENGTH(SRC)+LENGTH(DEST)  <=  DESTLENG)  THEN 

2360  0  24:2  21  BEGIN 

2361  0  24:3  21  ONRIGHT  :=  LENGTH(DEST) -INSINX+1 ; 

2362  0  24:3  30  IF  ONRIGHT  >  0  THEN 

2363  0  24:4  35  3EGIN 

2364  0  24:5  35  MOVERIGHT ( pESTC INSINX3,DESTCINSINX+LENGTH(SRC ) D. ONRIGHT) J 

2365  0  24:5  46  ONRIGHT  :=  0 

2366  0  24:4  46  END; 

2367  0  24:3  49  IF  ONRIGHT  =  0  THEN 

2368  0  24:4  54  BEGIN 

2369  0  24:5  54  MOVELEFTC SRCCl 3, DESTC INSINX3,LENGTH( SRC ) ) ; 

2370  0  24:5  63  DESTC03  :=  CHR (LENGTH(DEST) +LENGTH( SRC ) ) 

2371  0  24:4  72  END 

2372  0  24:2  73  END 

2373  0  24:o  73  END  (*SlNSERT*)  ; 

2374  0  24:o  86 

2375  0  25:d  1  PROCEDURE  SCOPY(*VAR  SRC, DEST;  STRING;  SRCINX , COPYLENGI  INTEGER*); 

2376  0  25:o  0  3EGIN  DEsT  :=  ••; 

2377  0  ?5:i  6  IF  (SRCiNX  >  0)  AND  (COPYLE^   >  0)  AND 


£376  0  25:i  13        (  SKC  INX  +  COPYLEMG-1  <=  LENSTHCSRO)  THEN 

?379  0  2b:2  25      BEGT^ 

2380  0  25:3  25        MOVELEFT ( SRCC SRC INX 3 i DESTCl D , COPYLENG ) ; 

2381  0  25:3  32        DESTCOD  :=  CHR ( COPYLENG) 

2332  0  25:2  35      END 

2333  0  25:0  36  ElMD  (♦SCOPY*)  ! 
238»+  0  25:o  48 

2385  0  2&:0      1  PROCEDURE  SDELETE(*VaR  DEST;  STRING;  DELINK .DELLENG :  INTEGER*); 

2336  0  26:D      4    VAR  ONRlGHT:  INTEGER' 

2387  0  26:0      0  BEGIN 

2388  0  26:i      0    IF  (DELINX  >  0)  AND  <DELLENG  >  0)  THEN 

2389  0  26:2      9      BEGIN 

2390  0  26:3      9        ONriGHT  :=  LENGTH{DEST ) -DELINX-DELLENG+1 ; 

2391  0  26:3  20        IF  ONRIGHT  =  0  THEN  DESTCOD  :=  CHR{DELINX-1 ) 

2392  0  26:3  30        ELSE 

2393  0  26:4  33         IF  ONRIGHT  >  0  THEN 

2394  0  26:5  38  BEGIN 

2395  0  26:6  38  MOVELEFT( DESTCDELINX+QELLENGD.DESTCDELINXD. ONRIGHT) I 

2396  0  26:6  47  DESTC03  :=  CHR( LENGTH( OEST) -DELLENG) 

2397  0  26:5  54  END 

2398  0  26:2  55      END 

2399  0  26:q  55  END  (♦SDELETE*)  ; 

2400  0  26:0  68 

2401  0  27:D      3  FUNCTION  SPOS(*VAR  TARGET,  SRc:  STRING*); 

2402  0  27:D      5  LABEL  i; 

2403  0  27:D      5  VAR   TEMrlOCDIST:  INTEGER? 

2404  0  27:d    7     firstch:  char; 

2405  0  27:D      8       TEMp:  STRING; 

2406  0  27:o    0  BEGIN  spqs  :=  o; 

2407  0  27:i      3    IF  LENgTH( TARGET)  >  0  THEN 

2408  0  27:2  10      BEGIN 

2409  0  27:3  10        FiRSTCH  :=  TARGETC13; 

2410  0  27:3  15       TE^pLOC  :=  1; 

2411  0  27:3  16        DiST  :=  LENGTH( SRC ) -LENGTH! TARGET)  +  l; 

2412  0  27:3  29        TE^PCOD  :=   TARGETC03; 

2413  0  27:3  36        WHILE  TEMPLOC  <=  DIST  DO 

2414  0  27:4  41  BEGIN 

2415  0  27:5  41  TEMPLOC  :=  TEMPLOC  +  SCAN ( DIST-TEMPLOC ,=FIRSTCH»SRCCTEMPLOC D)  ; 

2416  0  27:5  55  IF  TEMPLOC>DIST  THEN 

2417  0  27:6  60  GOTO  1;  p.>^ 

2418  0  27:5  62  MOVELEFT ( SRCC TEMPLOC 3f TEMPC 1 D. LENGTH( TARGET) ) ;  ^^ 


6^^ 
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43:D 
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0 
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59 
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43:4 
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43:4 

69 
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0 

43:3 

79 

2443 

0 

43:2 

81 
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43:2 

92 
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97 
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43:2 

97 

2448 
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43:3 

97 

2449 
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104 
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0 

43:3 

104 
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0 

43:2 

104 

2452 

0 
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134 
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0 

43:3 

144 
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0 
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151 
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0 
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0 

43:5 

157 
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0 

43:6 

165 
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0 
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IF  temp=targe:t  then 

:jEGlrJ    SP3S     :=    TEMPLOC;     GOTO    1    END; 
TEHPLOC     :=    TE:^PL0C  +  1 

end; 
i: 
END  (♦spds*)  ; 

(*  MAIN  DRIVER  OF  SYSTEM  *) 
PROCEDURE  command; 

VAR  t:  integer; 

BEGIN  STATE  !=  HALTlNiT; 
REPEAT 

RELEASE(EMPTYHEAP) 5 

WHILE  UNITABLECSYSC0M*.SYSUNIT3.UVID  <>  SYVID  DO 

BEGIN 

PL  :=  'PUT  IN  :•; 

INSERT(SYVIDiPLi8) ; 

PROMPT;  T  :=  4000; 

REPEAT  T  :=  T-1 
UNTIL  T  =  0; 

IF  fetchdir(syscom*.sysunit)  then 

END! 
STATE  :=  GETCMD(STATE) ; 
CASE  STATE  OF 

UPR0GN0U,UPR0GU0K,SYSPR06. 

componly»compandgo,compdebug» 
linkandgo»linkdebug: 

userprogram(nil,niL) ; 
debugcall: 
debugger 
end; 
IF  state  in  ccomponly,compa!\idgo,compdebugd  then 

if  USERINFO.ERRNUM  =  0  THEN 

begin     CTHIS  is  continued  in  FINISHC0MP3 
FCLOSE (USER  INFO. CODEFIBP*, CLOCK); 

IF  ord(Ioresult)  <>  ord(Inoerror)  then 

BEGIN 

T  :=  igresult; 

WRITELN (OUTPUT) ' 
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0 
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0 
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14 

2482 
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1:0 

19 

CLEARLIfJfc.; 

PRINTERRORdOCIOERRORDiT)  ; 
END; 
end; 
IF  STATE  IN  CUPROGNOU,UPROG'JOKD  THEN 
BEGIN 

FCLOSE{GFILESC03'^,CN0RMAl)  ; 
FCLOSE(GFILESC 13*, CLOCK) 
end; 
IF  UlMlTBUSYd)  OR  UNITBUSY(2)  THEN 
UNITCLEAR(I) 
UNTIL  STATE  =  HALTINIT 
END  (*C0MMAND*)  ; 

BEGIN  (*UCSD  PASCAL  SYSTEM*) 
EMPTYHEAP  :=  NIL; 
INITIALIZE; 
REPEAT 
COMMAND; 

IF  EMPTYHEAP  <>  NIL  THEN 
INITIALIZE 
UNTIL  EMPTYHEAP  =  NIL 
END  (*PASCALSYSTEM*)  . 
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i; 
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1    (*JL    PKl'jTLR;*) 
1    rSI    GLOBALS.TEIXn 
1     (*$U-*) 
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(*  ♦) 

(*  COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.  *) 

(*  PEf^MISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-  *) 

(♦  TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE  *) 

(*  OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS,  ♦) 

(*  *) 
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1  PROGRAM  PASCALSYSTEM; 
1 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

1  CONST 

1       MMAXINT  r  32767; 
1       MAXUNIT  =  12; 
1      maxdiR  =  77; 
1       VIDLENG  =  7; 

1  tidleng  =  15; 

1  niaXseg  =  15; 


*  *) 

*  ucsD  pascal  operating  system  ♦) 

*  ♦) 

*  release  level:  i.s   august*  1977  *) 

*  1.4    JANUARY,  1978  *) 

*  1.5    SEPTEMBER,  1978  *) 

*  II, 0   FEBRUARY,  1978  BD    *) 

*  *) 

*  WRITTEN  BY  ROGER  T,  SUMNER  *) 

*  WINTER  1977  *) 

*  *) 

*  INSTITUTE  FOR  INFORMATION  SYSTEMS  *) 

*  UC  SAN  DIEGO.  LA  JOLLA,  CA  *) 

*  *) 

*  KENNETH  L.  30WLES,  DIRECTOR  «) 

*  ♦) 


(♦MAXIMUM  INTEGER  VALUE*) 

(♦MAXIMUM  PHYSICAL  UNIT  U    FOR  UREAD*) 

(♦MAX  NUMBER  OF  ENTRIES  IN  A  DIRECTORY^) 

{♦NUMBER  OF  CHARS  IN  A  VOLUME  ID*) 

(♦NUMBER  OF  CHARS  IN  TITLE  ID^) 

(♦MAX  CODE  SEGMENT  NUMBERS) 
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F3t-KSlZF:  =  S12; 
DIR3LK  =  ^-! 
AGtLJf^lr  =  300; 

f:cl  =  ij; 
DLL  =  is; 

FILlIlE'J  = 


TYPE 


23; 

ii; 


(*STAr>jU'\KD  DISK  BLOCK  LENGTH*) 

{*DISK  ADDR  OF  DIRECTORY*) 

{*MAX  AGE  FOR  GOIRP...IN  TICKS*) 

(*END-0F-LINE.. .ASCII  CR*) 

(♦BLANK  COMPKESSIQN  CODE*) 

CLENGTH  OF  CONCAT ( VIOLENG . • : ♦ »TIDLENG ) 3 

CMAXIMUM  it    OF  NULLS  IN  FILLERl 


ioRsltwd  = 


{IN0rRK0R,IBA0BL0CK,I3ADUNlT,IBADM0DE,ITIJE0UT, 
IL0iTUNIT.IL0STFILE,lBADTITLEtlN0R00M»IN0UNIT, 

inofile,idupfile,inotclosed,inotopen»ibadformat, 
istrgovfl) ; 

(♦COMMAND  STATES... SEE  GETCMQ*) 

CMDSTATE  =  (HALTlNIT,DEBUGCALL» 

UPROGNOU,UPROGUOK»SYSPROGt 
COMpONLY,COMPANDGOtCOMPDEBUGf 
LINKANDG0»LINKDEBUG) ; 

(♦CODE  FILES  USED  IN  GETCMD*) 
SYSFILE  =  (ASSMBLER,COMPILER»EDITOR,FlLERiLlNKER)! 

(♦ARCHIVAL  INF0.,,THE  DATE*) 


DATEREC  =  PACKED  RECORD 

month:  0..12; 

day:  o.,3i; 
year:  0..100 
end  {*daterec*) 


UNITNUM  =  O..MAXUNIT; 
VXD  =  STRINGCVIDLENGD5 

OIRRANGE  =  O..MAXDIR; 
TID  =  STRINGCTlDLENGi; 


(*0  IMPLIES  DATE  NOT  MEANINGFUL*) 

(*OAY  OF  MONTH*) 

(*100  IS  TEMP  DISK  FLAG*) 


(♦VOLUME  TABLES^) 


(♦DISK  DIRECTORIES^) 
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FJLi__i;j    =    STKii\iGCiMAr'1E_LLr-jD; 

FIL£:_TAdLE  -    ARRAY  CSYSFlLE]  OF  FULL-lOj 


FILEKlMO  r 


(UrNlTYPtOFlLEfXDSKFlLEfCODEFILEtTEXTFlLE, 

infofile,datafile.gkaffile.fotofile,se;curedir)  ; 


DIREnTRY  =  PACKED  RECORD 

DFIRSTBLK;  I.^JTEGER; 
DLASTBLK:  INTEGER; 

case  dfkind:  filekind 
securedir, 
untypedfile:  (♦only  in 

(FILLERl  :  0,.2048; 

dvid:  vid; 

OEOVBLK:  INTEGER; 


(*FIRST  PHYSICAL  DISK  ADDR*) 
(♦POINTS  AT  BLOCK  FOLLOWING^ ) 
OF 


DIRCOa.. .VOLUME  INFO*) 

CFOR  DOWNWARD  COMPATIBILITY , 13  BITSD 

(♦NAME  OF  DISK  VOLUME*) 

(♦LASTBLK  OF  VOLUME*) 


DNUMFILES:  DIRRANGE;     (*NUH  FILES  IN  DIR*) 
DLOADTIME:  INTEGER;      (*TIME  OF  LAST  ACCESS*) 
DLASTBOOT:  DATEREC);     (*MOST  RECENT  DATE  SETTING*) 

XDSKFILEfCODEFILE,TEXTFlLE»lNFOFILE, 

DATAFILE»GR AFFILE «F0T0FILE; 


END 


(filler2  :  0..1024;  cfor 
status  :  boolean; 
dtid:  tio; 

dlastbyte:  l.fblksize; 
daccess:  daterec) 
(♦direntry*)  ; 


DOWNWARD  COMPATIBILITY] 

CFOR  FILER  WILDCARDS^ 
(*TITLE  OF  FILE*) 
(*NUM  BYTES  IN  LAST  BLOCK*) 
(*LAST  MODIFICATION  DATE*) 


DiRp  =  '^directory; 


DIRECTORY  =  ARRAY  CDIRRANGE3  OF  DIRENTRY; 

(*FILE  INFORMATION*) 

CLOSETYPE  =  (CiMORMALtCLOCKiCPURGE.CCRUNCH)  ; 
WINQOWP  =  '"WINDOW; 

WINDOW  =  PACKED  ARRAY  C0,,0D  OF  CHAR; 
FI3P  =  -"FIB; 


FIB  =  RECORD 

FWINOOW:  WINDOWP; 


(*USER  WINDOW. •.F'"»  USED  BY  GET-PUT*) 
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FEOF, 
FfSTAT 
FKECS 
CASE 
TRU 


FEOL 

t:  ( 
ize: 
Fiso 
E:  ( 


N:  tiOOLE 

(- JAMDWiF 

INTEGER 

HETm:  300 

fisblkd: 
funit:  u 
fviq:  VI 

FREPTCNT 
FNXTBLK, 
FMAXBLK: 
FMODIFIE 
FHEADER: 
CASE  FSO 

true: 


A'N; 
NEEDCHARiFG 

;  (*irj  BYTE 

LEAN  OF 
30CLEAN 

nitnjm; 
d; 


otchaR) ; 

S...0=>BLOCKFlLEf 


1=>CHARFILE*) 


( 
( 
( 
( 
( 

integer;  ( 

d:boolean;  ( 

direntry; { 

FT3UF:  BOOL 
(FNXTBYTEtF 

fbufchngd: 
fbuffer:  p 


END  (*FI3+) 


♦FILE  is  ON  BLOCK  DEVICE*) 
♦PHYSICAL  UNIT  U*) 
♦VOLUME  NAME*) 
*  U    TIMES  F-  VALID  W/O  GET*) 
♦NEXT  KEL  BLOCK  TO  10*) 
♦MAX  REL  BLOCK  ACCESSED*) 
♦PLEASE  SET  NEW  DATE  IN  CLOSE*) 
♦COPY  OF  DISK  DIR  ENTRY*) 

ean  of  (*disk  get-put  stuff*) 
maxbyte:  integer; 
boolean; 

ACKED  ARRAY  C 0 , .FBLKSIZED  OF  CHAR)) 


(♦USER  WORKFILE  STUFF*) 


inforec  =  record 

symfibp,codefi3p:  fibp; 
errsym,errblk»errnum:  integer; 
slowterm,stupio:  boolean; 
altmode:  char; 
gotsym,gotcode:  boolean; 
workvid,symvid.codevid:  vid; 

WORKTiDtSYMTlOtCODETIO:  TID 
END  (*INFOREC*)  ; 


(♦WORKFILES  FOR  SCRATCH*) 
(♦ERROR  STUFF  IN  EDIT*) 
{♦STUDENT  PROGRAMMER  ID!!*) 
(♦WASHOUT  CHAR  FOR  COMPILER*) 
(♦TITLES  ARE  MEANINGFUL*) 
(*PERM&CUR  WORKFILE  VOLUMES*) 
(♦PERMSCUR  WORKFILES  TITLE*) 


SEGraNGE  =  O..MAXSEG; 

segdesc  =  record 

diskaddr:  integer; 
codeleng:  integer 

end  (*SEGDESC^)  ; 


BYTERANGE  =  0..25b; 


(♦code  segment  layouts*) 


(*REL  BLK  IN  CODE...ABS  IN  SYSCOW**) 
{*«  BYTES  TO  READ  IN*) 


(*DEBUGGER  STUFF*) 
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TRICKAHRAY  =  RlCOKD         C^-^lEviORY  DIDDLING  FOR  EXECERRORD 
CASE  BOOLEAM  OF 

TRUE  :  (WORD  :  ARRAY  C0,.03  OF  INTEGER); 
FALSE  :  (3YTE  :  PACKED  ARRAY  CO, .03  OF  3YTERANGE) 
end; 
MSCt^'p  =  '>  MSCW;  (*MARK  STACK  RECORD  POINTER*) 

MSCa  =  RECORD 

STATLINK:  MSCWP;   (*P0INTER  to  parent  MSCW*) 

dynlink:  mscwp;   (*pointer  to  caller's  MSCW*) 
mss£g,msjtab:  '"trickarray; 
Msipc:  integer; 
localdata;  trickarray 
end  (*MSCW*)  ; 

<*systeh  communication  area*) 


SYSCOMREC  =  record 

iorslt;  iorsltwd; 
xeQERR:  integer; 
sysunit:  unitnum; 
bugstate:  integer; 
gdiRp:  dirp; 
lastmp,stkbase,bombp: 


<*SEE  interpreters. ..NOTE  *) 
(*THAT  WE  ASSUME  BACKWARD  *} 
(♦FIELD  allocation  IS  DONE  *) 


memtop,se6,jtab:  integer; 


(♦RESULT  of  last  10  CALL^) 
(♦reason  for  EXECERRQR  CALL^) 
(♦physical  unit  of  BOOTLOAD^) 
(♦debugger  INFO^) 

{♦GLOBAL  DIR  POlNTERfSEE  VOLSEARCH^} 

mscwp; 


(♦WHERE  XEQERR  BLOWUP  WAS*) 
(♦more  debugger  STUFFS) 
OF  INTEGER; 

(♦drivers  put  RETRY  COUNTS^) 
>83  OF  integer; 


BOMBIPc:  INTEGER; 
HLTLINE:  INTEGER; 

brkpts:  array  C0..3D 

retries:  INTEGER; 

expansion:  array  co..i 

HIGHTlMEfLOWTIME:  INTEGER; 
MISCINFO:  PACKED  RECORD 

NOBREAK* stupid, SLOWTERMt 

HASXYCRT,HASLCCRT,HAS85XOA,HASCLOCK:  BOOLEAN; 

USERKIND: (NORMAL*  AQUIZ,  BOOKER,  PflUIZ); 

IS_FLIPT  ;  BOOLEAN 
END; 
CRTTYPE:  INTEGER; 

crtctrl:  packed  record 

rlf.ndfsferaseeolferaseeos, home, escape:  char; 
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VAR 


OF  BOOLEAN 


dACKSPACE:  char; 

fillcqunt:  0..255; 
clearscreeni  clearlinl;  char; 
prefixed:  packed  array  [:o.,sd 

END; 

CKTINFO:  PACKED  RECORD 

WIDTH, height:  integer; 

RIGHT, LEFT, DOWN, UP:  CHAR; 

BADCH,CHARDEL, STOP, BREAK, FLUSH, EOF:  CHAR; 

ALT^'OOE,LI^JEDEL:  CHAR; 

BACKSPACEfETX, prefix:  CHAR; 

prefixed:  PACKED  ARRAY  CO, ,13]  OF  BOOLEAN 

end; 
segtable:  array  csegranged  of 

RECORD 

cooeunit:  unitnumj 
codedesc:  segdesc 
end 
end  (*syscom*); 


MISCINFOREC  = 


RECORD 

msyscom: 
end; 


syscomrec 


SYSCOm:  ^SYSCOMREC! 

gfiles:  array  C0..53  of  fibp; 
USERINFO:  inforecj 
emptyheap:  '^integer; 
inputfib,outputfib« 
systerm,swapfib:  FIBP; 
syvio,dkvid:  VID; 
thedate:  DATEREC; 
debuginfo:  '^integer; 
state:  CMDSTATE; 
pl:  string; 

ipot:  array  co. ,43  of  integer; 
filler:  stringcfill.lend; 
digits:  set  of  •o'^.'g* ; 
unitable:  array  lunitnum^  of  {*o 
record 


(♦magic  param,..set  up  in  boot*) 
{♦global  filesf  0=input.  1=0utput*) 
{♦work  stuff  for  compiler  etc*) 
{♦heap  mark  for  mem  managing*) 
(♦console  files. ..gfiles  are  copies*) 
(♦control  and  swapspace  FILES^) 

(♦SYSUNIT  VOLID  &    DEFAULT  VOLlD^) 

{♦TODAY...SET  IN  FILER  OR  SIGN  ON^) 

(♦DEBUGGERS  GLOBAL  INFO  WHILE  RUNIN*) 

(*FOR  GETCOMMAND*) 

(♦PROMPTLINE  STRING. ..SEE  PROMPT^) 

(♦INTEGER  POWERS  OF  TEN*) 

(♦NULLS  FOR  CARRIAGE  DELAY+) 

NOT  USED+) 
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u\jid:   vio;    (*\/olume  id  for  unit*) 
CASE  uisblkd:  boolean  of 
true:  (ueovslk:  integer) 
end  (*unitable*)  ; 

FILENAME    :    FILE_TAtlLE; 

(* -- 

(*  SYSTE^^  PROCEDURE  FORWARD  DECLARATIONS  *) 
{*  THESE  ARE  ADDRESSED  BY  OBJECT  CODE...  *) 

(♦  DO  NOT  Move  without  careful  thought  *) 

PROCEDURE  EXECERROR; 
FORWARD; 


•*) 


FiNiTiVAR  f:  fib;  window:  windowp;  recwords:  integer); 
freset(var  f:  fib)  ; 


PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 

PROCEDURE  FOPEN(VAR  f:  fib;  var  ftitle:  string; 

FOPENOLD:  BOOLEAN;  JUNK:  FIBP); 

FORWARD 
PROCEDURE  FCLOSE(VAR  FI  FIB;  FTYPE!  CLOSETYPE); 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 


fgetcvar  f:  fib) ; 

FPUKVAR   F:    FIB); 

xseek; 


FORWARD 
FUNCTION  FEOF(VAR  F:  FIB):  BOOLEAN; 

FORWARD 
FUNCTION  FEOLN(VAR  F:  FIB):  BOOLEAN; 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE  FREADCHAR(VAR  F:  FIB;  VAR  CHI  CHAR); 


FREADINT(VAR  F:  FIB;  VAR  I:  INTEGER); 
FWRITEINT(VAR  F:  FIB;  ItRLENG:  INTEGER); 
XReADREAL; 
XWRITEREAL; 
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18:d 

292 

0 

19:lj 

294 

0 

19:d 

294 

0 

2o:o 

295 

0 

2o:d 

296 

0 

2i;d 

297 

0 

2i:d 

298 

0 

22:d 

299 

0 

22:d 

300 

0 

23:d 

301 

0 

23:d 

302 

0 

24:d 

303 

0 

21:0 

304 

0 

25:d 

305 

0 

25:d 

306 

0 

26:o 

307 

0 

26  :o 

308 

0 

27:d 

309 

0 

27;d 

310 

0 

28:o 

311 

0 

28:d 

312 

0 

28:d 

313 

0 

29:d 

3m 

0 

29:d 

315 

0 

29:d 

316 

0 

29:d 

317 

0 

29:d 

318 

0 

3o:d 

319 

0 

3o:d 

320 

0 

3o;o 

321 

0 

3i:d 

322 

0 

3i;d 

323 

0 

32:o 

32H 

0 

32:o 

325 

0 

33:d 

326 

0 

33:d 

327 

0 

33:d 

i    FORWARD 

1  procedure: 

4    FORwARJ 

1  procedure: 

4  FORWARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 

5  FORWARD 

1  PROCEDURE 

2  FORWARD 

1  PROCEDURE 

2  FORWARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 

5  FORWARD 
1  PROCEDURE 
5  FORWARD 
1  PROCEDURE 


FWRITECHAR(VAR  FI  FIB;  CH:  CHAR;  RLENG:  INTEGER); 
FREADSTRING(\/AR  F:  FI3;  VAR  S:  STRING;  SLENGI  INTEGER); 
FWRITESTRI[.iG(VAi^  F:  FIB;  VAR  S:  STRING;  RLENG;  INTEGER); 
FWHITEBYTES(VAR  F:  FI3;  VAR  A:  WINDOW;  RLENG. ALENG:  INTEGER); 
FREADLIM(VAR  F:  FIB)  ; 
FWRITELN(VAR  F:  FIB)  ; 

SCONCAT{VAR  DESTiSRc:  STRING;  DESTLENG;  INTEGER); 
SINSERKVAR  SRC.DEST:  STRING;  DESTLENG, INSINX;  INTEGER); 
SCOPY(VAR  SRC.DEST!  STRING;  SRCINX .COPYLENG:  INTEGER); 
SDELETE(VAR  DEST!  STRING?  DELINK. DELLENGI  INTEGER); 


4  FORWARD; 
3  FUNCTION  SPOS(VAR  TARGET, SRC:  STRING)!  INTEGER; 

5  FORWARDi 
3  FUNCTION  FBLOCKIO(VAR  F!  FIB?  VAR  A!  WINDOW;  II  INTEGER; 

6  NBLOCKS.RBLOCK:  INTEGER;  DOREADI  BOOLEAN)!  INTEGER; 
9    FORWARD; 

1  PROCEDURE  FGOTOXY(X,Y!  INTEGER); 

3    FORWARD; 

3 

3  (*  NON  FIXED  FORWARD  DECLARATIONS  ♦) 

3 

3  FUNCTION  V0LSEARCH(VAR  FVID!  VID;  LOOKHARD!  BOOLEAN; 

5  VAR  FDIR!  OIRP)!  UNITNUM; 

6  FORWARD; 

1  PROCEDURE  WRITEDIR(FUNIT!  UNITNUM;  FDIRI  OIRP) 5 

3    FORWARD; 

3  FUNCTION  DIRSEARCH(VAR  FTID!  TID;  FINDPERM!  BOOLEAN;  FDIR!  OIRP)!  DIRRANGE; 

6    FORWARD; 

3  FUNCTION  SCANTITLE(FTITLE:  STRING;  VAR  FVID!  VID;  VAR  FTID!  TID; 
6  VAR  FSEGS!  INTEGER;  VAR  FKINDl  FILEKIND)!  BOOLEAN; 

49    FORWARD; 


323 

329 

330 

331 

332 

333 

331 

335 

33b 

337 

336 

339 

340 

341 

342 

343 

344 

345 

346 

347 

348 

349 

350 

350 

351 

352 

353 

354 

355 

356 

357 

358 

359 

360 

361 

362 

363 

364 

365 

366 

367 


0 

Q 
J 
3 
G 
0 
0 

u 

0 
0 
0 
0 
0 
0 
0 

u 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

Q 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 


•  ^ 

J  D 

:  J 

ID 

:o 
:d 
:d 

:o 

ID 

:d 
:d 
:d 
:o 
:d 
:d 


34 
34 
35 
35 
36 
36 
37 
37 
38 
38 
39 
39 
40 
40 
41 
41 
42:D 

42:d 
43:d 
43:d 
43:d 

'♦SID 

43:d 
43:q 
43:d 
43:d 
43:u 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 
43:d 


1    PKOCecUKE    OELENTRYtFlNX:     DIRKAIMGE.;     FDIK:    DIRP); 

3  FORWARD; 

1    PROCEDURE    ir\ISENTRY(\/AR    FENTRY:     DIRENTRY;    FINX:    DIRRANGE;    FDIR*.    DIRP); 

4  FORWARD; 

1  PROCEDURE  HOMECURSOR; 

1    FORWARD; 

1  PROCEDURE  CLEARSCREEfj; 

1    FORWARD; 

1  PROCEDURE  CLEARLINE; 

1    FORWARD; 

1  PROCEDURE  PROMPT; 

1    FORWARD; 

3  FUNCTION  sPACEWAITCFLUSH:  BOOLEAN):  BOOLEAN? 

4  FORWARD; 

3  FUNCTION  GETCHAR(FLUSH:  BOOLEAN):  CHAR; 

4  FORWARD; 

3  FUNCTION  FETCHDIR(FUNIT:UNITNUM)  :  BOOLEAN; 

4  FORWARD; 

1  PROCEDURE  COMMAND; 

1    FORWARD; 

1 

1 

1  CSI  GLOBALS.TEXTJ 

1  C$1  FILER. VARS.TEXTJ 

1  [:****♦*******♦*********»*♦*******♦♦♦*♦♦*♦♦*♦*** 
1  c 

1  C  UCSD  PASCAL  FILEHANOLER 

1  C 

1  c 

1  c 

1  c 

1  c 

1  c 

1  c 

1  c 

1  i: 

1  i: 

1  c 

1  c 

1  c 

1  L 


RELEASE  level:   II. 0  FEBRUARY*  1979 


WRITTEN  BY  ROGER  T.  sUMNER 

RELEASE  LEVEL  I.4«  WINTER  1977 

WRITTEN  BY  STEVEN  S  THOMSON 

RELEASE  LEVEL  F.5A  SUMMER  1979 
RELEASE  LEVEL  H.O  WINTER  1978-79 

INSTITUTE  FOR  INFORMATION  SYSTSEMS 
UC  SAN  DIEGOt  LA  UOLLA,  CALIFORNIA 
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566 
369 
370 
371 
372 
373 
37H 
375 
376 
377 
378 
379 
380 
381 
382 
383 
384 
385 
386 
387 
388 
389 
390 
391 
392 
393 
39«f 
395 
396 
397 
398 
399 
400 
401 
402 
403 
404 
405 
406 
407 
408 


0 

0 
0 
0 
0 

c 

0 
0 
0 

u 

0 
0 


43:d 
43  :c 
43:j 
^  3 :  u 

43:Lj 

43  ;d 

43: 13 

43  :g 

43:0 

43:d 


43: 

43; 

i: 

i; 


i:d 
i:d 
i:d 
i:d 
i:d 
i:o 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 


:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:o 
:d 
:d 
:u 


1 
1 
1 
1 
1 

1 
1 
1 
1 
1 
1 
1 

3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
5 
3 


L  KENNETil  L.  BO^^LES.  DIKECTOK  1 


Z  COPYRIGHT  (C)  1979  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA. 

C  PERMSSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN- 

C  TATION  IN  HARD  OK  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE 

C  OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS. 


SEGMENT  PROCEDURE  FILEHANDLER { ZZZZZ ,ZZZZZZ  :  INTEGER)} 


CONST 

DIRLAST3LK 
MAXTITLE 

VOLONLINE 
TEXTLOST 
COOELOST 
FOUNDFILE 

BLKDEXp 

UNBLKDEXP 
FILEEXp 


TYPE 

UNTYPED   = 

TIDRANGE  = 

MATCHEIS  = 
LOCATION  = 
CHECKS    = 


6; 

DUPDIRLASTBLK 

= 

105 

SHSTRLENG 

40; 

HALFMAXDIR 

= 

39; 

10135 

FILEUNBLKDEXP 

— 

1020; 

NOWRK 

1014! 

FILEBLKDEXP 

= 

1021! 

NOWILD 

10155 

FILEVOLEXP 

— 

1022! 

BADFORM 

1016! 

VOLEXP 

s 

1023! 

ILLFILEVOL 

1017! 

FILEFULL 

:: 

1024! 

ILLCHANGE 

1018! 

WRKSAVED 

= 

1025! 

SADDEST 

1019! 

NODIR 

IS 

10265 

BLKD 
UNBLKD 

1027! 
1028! 
1029; 
1030; 
1031; 
1032; 
1033; 

103**; 


FILE; 
O..TIDLENG; 

(FILEFOUND,  NOFlLESt  FILESNOGOOD,  ABORTIT) 
(SOURCE, DESTlNATlONtNEITHER) ; 
(BADTlTLEt  BADUNiTt  NOVOLt  BADDIR. 
BADFlLEt  UNBLKDVOL.  OKDIR,  OKFILE)! 


CHCKS 


=  SET  OF  CHECKS! 


LONGSTRING 
SHORTSTRING 


=  STRINGC2553; 

=  STRINGCSHSTRLENSD; 


409 

HlO 

411 

412 

413 

414 

415 

416 

417 

418 

419 

420 

121 

422 

423 

424 

'♦25 

426 

427 

428 

429 

430 

431 

432 

433 

434 

435 

436 

437 

438 

439 

440 

441 

442 

443 

444 

445 

446 

447 
448 
449 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


x: 
1; 
i; 
i; 
i; 
i; 
i; 


i:d 
i:d 
i:o 
i:d 
i;d 
i:d 
i:d 

110 

i:d 
i:d 
i:o 
i:d 
i:d 
i:d 
i:d 
i;o 
i;d 
i;d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:o 
i:o 
i:d 
i:d 
i:d 
i:g 
i:o 
i:d 
i:d 


0 

^ 

3 

3 
3 
3 
3 
3 
3 
4 
4 
4 
7 
7 
8 
8 
9 
10 
10 
10 
10 
10 
10 
16 
16 
17 
18 
18 
19 
19 
20 
20 
26 
26 
26 
27 
27 
67 


STRMG 

ABlOCK 

BITMAP 


=  STRINGLMAXTITLE3; 

=    ARRAY    L0,,255:    OF    iNTEGtiR; 

=  PACKED  RECORD 

DIRENTRY  :  PACKED  ARRAY  CDIRRANGE3  OF  BOOLEAN; 
ENTRIES  :  dirrange; 

END; 


UAR 

GBUFBLKS 

SOURCEJNIT*  DESTUNlTi 

GUNIT 


CH 

GDIR 
LFIBP 

FAST, 

MARKING, 

QUESTlONt  WILDCARD, 

TEXTSAVEDt  CODESAVED 


LASTSTATE 
FOUND 

GBUF 

GKIND 

DIRMAP 

BLOCKPTR 
LFIS 


INTEGER; 

UNITNUM; 
CHAR; 

DIRP; 
FIBP; 


:  BOOLEAN; 

:  CHECKS; 

:  MATCHES; 

:  WINOOWP; 

:  FILEKIND; 

:  BITMAP; 

:  '^ABLOCK; 

:  UNTYPED; 


L    BLOCKS  AVAILABLE  IN  TRANSFER  BUFFER 
C  UNITS  RELATED  TO  SOURCE  &    DEST.  FILES 
C  UNIT  «  THAT  LAST  VOLSEARCH  RETURNED 


C  GENERAL  PURPOSE  CHARARCTER 

C  POINTER  TO  THE  DIRECTORY  IN  USE 

C  POINTER  TO  THE  HEADER  OF  FILE  LFIB 

C  SYSCOM**  CNOT  SLOWTERM  S  (WIdTH  >  79)3 

C  MUST  USE  STATUS  BIT  IN  DIRECTORY 

C  IS  WILDCARD  OPTION  BEING  USED  ? 

C  WORKFILES  SAVED  7 


C  STATE  OF  LAST  CALL  TO  SCANINPUT 
C  RESULT  OF  DIR.  SEARCH  FOR  A  FILE 

C  POINTER  TO  THE  TRANSFER  BUFFER 

C  FILETYPE  (E.G.,  TEXT, CODE, DATA. .. ) 

C  KEEPS  TRACK  OF  THE  FILES  TO  BE  USED 
C  IN  A  WILDCARD  OPERATION 

C  POINTER  TO  ONE-BLOCK  OF  DATA 

C  GENERAL  PURPOSE  FILE 
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*+51 

452 

453 

454 

455 

456 

457 

453 

459 

4b  fj 

461 

462 

463 

464 

465 

466 

467 

468 

469 

470 

470 

471 

472 

473 

474 

475 

476 

477 

478 

479 

480 

481 

482 

483 

434 

485 

486 

487 

468 

489 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
1 
1 
1 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

l; 


.  iJ 

:d 
:o 

•  u 

:d 
:d 
i:o 
i:d 

I'.D 

i;o 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 


2: 
2; 
2: 
2; 


2:d 
3:o 
3:d 
3:d 
3:o 


b7 
£.7 
b7 
hi 
c7 
b7 
67 
91 
91 
51 
91 
91 
123 
123 
149 
174 
191 
233 
361 
361 
361 
361 
361 
361 
361 
361 
361 
361 
361 
361 
361 
361 
1 
1 
1 
1 
1 
3 
4 
4 
0 


DESTVlj,  SOURClVIo, 
GVI1J2 


SOURCETITLE, 

STRirv|G2,STRlNG4, 

GTID 


STRlNGl,  STRING3 

MONTHSTR 

TYPESTR 

FROMWHERE,  TOWHERE 

INSTRING 


vid; 


tid; 

shortstring; 
stringc48d; 

STRINGC323; 

strng; 
loimgstring; 
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C  VOLUME  NA^ES  OF  SOURCE  &    DESTINATION  1 

C  FILES  RESPECTIVELY.  AS  INPUTTED  3 

C  EXPLICIT  VOLUME  NAME  ASSOCIATED  WITH  : 

C  SOURCE  8  DEST  UNITS  RESPECTIVELY  ] 

C  LAST  VOLNAME  RETURNED  BY  SCANIPUT  2 

L  LAST  VOLNAME  ENTERED  INTO  SCANIPUT  1 


C  SOURCE  FILE  WITH  EXLICIT  VOLUME  NAME  3 
C  SUFFIX  STRINGS  TO  WILDCARDS  ] 

C  LAST  TITLE  RETURNED  BY  SCANIPUT       3 


C  PREFIX  STRINGS  TO  WILDCARDS 

C  CONTAINS  ABBR.  FOR  THE  MONTHS 

C  CONTAINS  ABBR.  FOR  THE  FILE  TYPES 

C  SOURCE  &    DESTINATION  FILES 

C  INPUT  STRING 


3 

3 
3 
3 
3 


C$1  FILER, VARS.TEXT3 

C$1  FILER,A.TEXT3 

C      COPYRIGHT  (C)  1979  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA. 

C      PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN- 

r  IS^^?!!  ^^    ^'^^^    °^  ^^""^  ^°^^   GRANTED  ONLY  BY  WRITTEN  LICENSE 

C      OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS. 


3 
3 
3 
3 


r  In^n    Pj°C°^f^^  IS  CALLED  IN  AN  INFINITE  LOOP.  USED  TO  EXIT  FROM  WHEN  AN      3 
PROCEDURE  cSllJrOc!'  ''^°'''""-  "^'^^    ^^'^^"^    '°    "AIN  FILER  PRSMPrLINE       3 
FORWARD; 


c  the'heaSer"f'tha'?'file  fTbp''  '  '''''''  ''  '  '''''''  ''''  ''  '  '''''^'   ^°  ' 

FUNCTION  GETPTR(VAR  DUMMY  :  UNTYPED)  I  FIBPJ   C  DUMMY  IS  PLACED  ON  THE  STACK  3 
SEGirf  '  "''''''^    "•*°'  °''  "^'''  ^    ^f'l^  IS  PLACED  ON  THE  STACK   3 


490 

1 

3:i 

Q 

tf^l 

1 

3:o 

6 

49a 

3: 'J 

22 

49i 

3:o 

22 

49'4 

3:g 

22 

495 

3:o 

22 

496 

3:o 

22 

497 

4:o 

1 

496 

4:o 

0 

499 

4:i 

0 

500 

4:i 

7 

501 

4:i 

15 

502 

4:i 

22 

503 

4:i 

29 

504 

4:i 

36 

505 

4:i 

44 

506 

f:i 

51 

507 

4:i 

58 

508 

4:i 

66 

509 

4:i 

73 

510 

4:i 

80 

511 

t:i 

63 

512 

4:i 

86 

513 

4:i 

89 

514 

«*:i 

92 

515 

'♦:i 

95 

516 

4:o 

102 

517 

4:o 

114 

518 

4:o 

114 

519 

4:o 

114 

520 

4:o 

114 

521 

4;o 

114 

522 

5:d 

1 

523 

5:d 

3 

524 

5:d 

3 

525 

5:o 

0 

526 

5:i 

0 

527 

5:i 

7 

528 

5:i 

7 

529 

5:i 

7 

530 

5:i 

10 

GETPTR  :=  TRIXC-i 2 

END; 


C  WE  ACCESS  DUMMY  AS  TYPE  FIBP  2 


C  INITIALIZES  GLOBAL  VARIABLES  FOR  THE  FILER  J 

PROCEDURE  INITGLOBALS; 

BEGIN 

GVID  :=  ••; 

STRlNGl 

STRIMG2 

STRINGS 

STRING^ 

TQWHERE 

volnamei 

V0LNAME2 
FROMWHERE  ;= 
SQURCEVID  := 
DESTVID  :=  »•} 

sourceunit  :=  O; 

DESTUNIT  :r  0; 
FOUND  :=  NOFILES; 

WILDCARD  :=  false; 

QUESTION  :=  FALSE! 

FILLCHAR{DIRHAP,SIZEOF(DIRMAP),0) 
END; 


♦•; 
»'; 


FILER  ERROR  MESSAGES 


C  WRITES  OUT  MOST  FILER  RELATED  AND  I/O  ERRORS.  IF  NUMBER  <>  0 
C  THEN  THIS  PROCEDURE  WILL  RETURN  TO  THE  FILER  PROMPT  LINE 
PROCEDURE  MESSAGES(NUMBER  :  INTEGER;  EXXIT  :  BOOLEAN); 
VAR 

STR  ;  STRINGC403; 
BEGIN 

STR  ;=  »»{ 


AND 


EXXIT  1 
2 


C i/Q  ERRORS 

CASE  NUMBER  OF 

1  :  STR  :=  'PARITY  (CRC)  ERROR'; 
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til 

532 
533 
534 
535 
536 
537 
53a 
539 
540 

542 
5H3 
5'*4 
5<+5 
546 
547 
548 
549 
550 
551 
552 
553 
554 
555 
556 
557 
558 
559 
560 
561 
562 
563 
564 
565 
566 
567 
568 
569 
570 
571 


1 

1 
1 
1 
1 

X 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


b: 
5; 
5: 

5 

b; 
b; 
5; 
5; 
5: 
5; 
5; 
5: 
5; 
5; 
5; 
5; 
5; 
5; 
5; 

51 
51 
51 

51 

5; 

51 

51 

5; 

51 
51 
51 

51 
51 
51 
51 
51 

5; 

5: 

51 
51 

51 
5: 


37 
ol 
37 
1U9 
155 
IbO 
162 
2C5 
233 
256 
284 
234 
284 
287 
315 
338 
361 
380 
397 
415 
433 
459 
483 
500 
517 
542 
568 
596 
624 
653 
701 
731 
775 
777 
860 
871 
906 
909 
929 
958 
960 


2 
3 
4 
5 
6 
7 
8 
9 
10 

end; 


;  STq  : 

;  SIR    : 

:    SIR  : 

:  STK  : 

:  ST<  : 

:  STK  : 

:  SIR  : 

:  ST,<  : 

:  STR  : 

'BAG  UNIT  r-JUMBER'  ; 
•BAC  1/0  OPERATION*  ; 
•TI^.EUUT  ERROR'  ; 
*\I0L    WENT  OFF-LINE*  ; 
•FILE  LOST  IN  3IR' ; 
•BAD  FILE  NAME» ; 
•NO  ROOM  ON  VOL* ; 
•NO  SUCH  VOL  ON-LINE' J 
•FILE  NOT  FOUND^; 


CASE  NUMBER 

1013:  STR 

1014:  STR 

1015:  STR 

1016:  STR 
1017«1033: 
I0l8tl034: 

1019:  STR 

1020:  STR 

l02i:  STR 

1022:  STR 

1023:  STR 

1024:  STR 

1025:  STR 

1026:  STR 

1027:  STR 

1028:  STR 

IO29:  STR 

1030:  STR 

1031:  STR 

IO32:  STR 

end; 

IF  number  I 
STR  :=  CO 
clearline; 
if  (nuviber 

WRITE( •I/ 
ELSE 

WRIT£(STR 


•  FILER  RELATED  ERRORS 

)F 
-  I 


VOL  ALREADY  ON-LINE' ; 

TEXT  FILE  LOST'; 

CODE  FILE  LOST'; 
;=  'FILE  FOUND' ; 
STR  :=  »BLKD  VOL'; 
STR  :=  'UBLKD  VOL'; 
;=  'FILE  NAME' ; 
;=  'FII-E/CUNBLKD  VOL)'; 
;=  'FILE/CBLKD  VOL)'; 
;=  'FILE/VOL'; 
:=  'VOL  NAME'; 
;=  'OUTPUT  FILE  FULL'; 
;=  'WORKFILE  IS  SAVED' ; 
!=  'NO  DIRECTORY  ON  VOL'; 
;=  'NO  WORKFILE  TO  SAVE'; 
:=  •WILDCARD  NOT  ALLOWED'; 

;=  •BAD  FORMAT  (WILDCARD  <T0>  NON-WILDCARD) • J 
;=  •ILLEGAL  FILE/VOL  NAME'; 
:=  'ILLEGAL  CHANGE  (VOL  <T0>  FILE)  NAME'; 
:=  'BAD  DEST  FOR  FILES  FOUND' 

N  C1017. .10233  THEN 
NCAT(STR.'  EXPECTED'); 

>  10)  AND  (NUMBER  <  1000)  OR  SYSCOW^.MISCINFO.SLOWTERM  THEN 

0  ERROR  «', NUMBER)   C  MISC.  I/O  ERROR,  PRINT  OUT  ERROR  ♦*  ONLY  1 

) ; 


^72  1  b:i  969  IF  EXXIT  THEN 

^^^  1  '^''^  97^  EXIT(CALLPROC) 

57*+  1  5:0  976  £f\ID; 

575  i  5:j  996 

^1°  ^  ^-3  ^'5°  ^    CHECKS  FOR  SELECTED  I/O  ERRORS.  WILL  PRINT  OUT  ERROR  AND  2 

^'"^  1  '^'^  3*56  C  RETLJRi^  TO  FILER  PROMPT  LITnJE  IF  OI^E  IS  FOUND                1 

S'^a  1  6:c  1  PROCEDURE  CHECKRSLT(RSLT  :  INTEGER); 

579  1  6:0  0  BEGIN 

5^^  1  ^:i  0  IF  (HSLT  >  0)  AND  NOT  (RSLT  IN  C13»m3)  THEN 

5S1  1  6:2  13  HES3AGES{RSLT,TRUE) 

532  i  6:0  15  END; 

583  1  6;0  30 

584  1  6:0  30  r 


WIDELY  USED  COMMAND  SEQUENCES 


585  1  6:a  30 

5S°  1  6*0  30  C  PERFORMS  A  WRITELN  FOLLOWED  BY  A  CLEARLINE  3 

587  1  7:D  1  PROCEDURE  WRITEANQcLEAR ; 

588  1  7:0  0  BEGIN 

589  1  7:1  0  writelN; 

590  1  7:1  6  CLEARLINE 

591  1  7;0  6  END; 

592  1  7:0  22 

593  1  7:0  22  C  READS  A  CHARACTER  FROM  INPUT.  RETURNS  TRUE  IF  THE  CHARACTER  WAS  A  ('YN'YMD 
IVt  J  l\l  22  C  FALSE  OTHERWISE.  EXITS  TO  PROMPT  LINE  IF  THE  CHARACTER  WAS  AN  <ESC>.  WILL  D 
595  1  7:o  22  L  POSITION  CURSOR  aT  START  OF  NEXT  LINE  IF  ALL  WENT  O.K.                      T 

596  1  8:d  3  FUNCTION  ngetchar(flush  :  BOOLEAN)  ;  bqqlean; 

597  1  6:o  0  BEGIN 

598  1  8:1  0  CH  :=  GETCHAR(FLUSH); 

5?^  1  a:i  a  if  (ch  =  syscom'-.crtinfo.altmoqe)  then 

600  1  8:2  20  EXIT(CALLPROC); 

601  1  8:i  24  NGETChAR  :=  ch  =  'Y»; 

602  1  e:i  29  IF  Not  eoln  then 

603  1  8:2  40  WRITELN 

604  1  8:0  40  END; 

605  1  6:0  58 

606  1  8:0  58 


07    1     8:0     58 


C  ASKS  THE  USER  TO  TYPE  A  SPACE  TO  CONTINUE.  WILL  RETURN  TO  THE  FILER  PROMPT  D 

,-^  ,  „_  ^    LINE  IF  THE  USER  RESPONDS  WITH  AN  <ESC>»  IF  FLUSH  THEN  PRECLUDES  TYPE-AHEA03 

^08  1  9:D  1  PROCEDURE  NSPACEWAlT ( FLUSH  :  BOOLEAN); 

609  1  9:o  0  BEGIN 

^^0  1  9:i  0  IF  SPACEWAIT(FLUSH)  THEN 

^11  1  9:2  a  EXIT(CALLPROC) 

612  1  9:0  12  END; 

77 


°l'+  1  9:0  ci4  :  USED  TO  UPDATE  DiRLCTORY  Ai^JD  CHECKS  THE  I/O  RESULT  1 

t>is  1  io:d  I  proceojre  updateuir; 

616  1  iO:0  0  3E3irj 

^17  1  10;i  u  WRlTELlR(SOUfsCEUNlT,GDlR)  ; 

*=ly  1  10:i  5  CHECXRSLTdORESJLT) 

bi9  1  10:0  7  END; 

620  1  10:0  22 

621  1  10:0  22  I MISCELLANEOUS  GRUNDGE  PROCEDURES 


622  1  10:0  22 

623  1  10:0  22    C  REmO\/eS  SPACES  A!\jD  UNPRINTABLE  CHARACTERS  FROM  INPUT  STRING.  3 
62^  1  10:Q  22    C  CHANGES  ALL  LOiJER-CASE  CHARACTERS  TO  UPPER-CASE  2 

625  I  ll:0      1    PROCEDURE  EATSPACES ( VAR  STRG  :  LONGSTRING); 

626  1  ll:0      2    VAR 

627  1  ii:d    2    I  :  integer; 

628  1  11:D      3 

629  1  ii:o    0   begin 

630  1  ii:i    0    I  :=  i; 

631  1  ii:i     3     while  I  <=  LENGTH(STRG)  DO 

632  1  11:2  10        if  {0RD(STRGCI3)  >=  33)  AND  {ORD( STRGC 1 D)  <=  125)  THEN 

633  1  11:3  23  3EGIN 

63f  1  ll:if  23  IF  (STRGCID  >=  'A')  AND  (STRGCI3  <=  'ZM  THEN 

635  1  11:5  3b  STRGCI3  :=  CHR(  ORD(  STRGCn  )  -  ORD(  'A'  )  +  ORD  ('A*  )); 

636  1  11:4  46  I  :=  I  +  1 

637  1  11:3  47  END 

638  1  11:2  51       ELSE 

639  1  11:3  53  DELETE(STRGtl.l) ; 

640  1  11:1  61  IF  STRG  =  ••  THEN 
6'+l  1  11:2  69  EXIT(CALLPROC)  ; 
6^2  1  11:0  73    END; 

643  1  11:0  88 

6'*'+  1  11:0  88    C  ASCERTAINS  THE  CORRECT  BLOCK  NUMBER  FOR  PROCEDURES  TO  USE  AT  A  GIVEN  TIME  1 

6^+5  1  H:n  aa    C  if  a  valid  DEOVBLK  exists  on  the  present  directory  then  the  user  WILL  BE   D 

6'+6  1  11:0  88    C  asked  IF  THAT  VALUE  IS  THE  CORRECT  ONE.  OTHERWISE  A  VALID  BLOCK  MUST  BE    3 

6'+7  1  11:0  88    C  ENTERED.  FOR  A  BLOCK  TO  BE  VALID  IT  MUST  BE  >=  LASTBLK  2 

648  1  12:d      1    PROCEDURE  GETBLOCKS (MESSl , MESS2 , MESS3  :  SHORTSTRING!  LASTBLKI  INTEGER; 

649  1  12:D  5  VAR  NBLOCKS;  INTEGER); 

650  1  12:D  45    VAR 

651  1  12:d  45    OK  :  boolean; 

632  1  12:0  0    BEGIN 

653  1  12:1  0     OK  :=  false; 


°^'+  1  12:1  1^  IF  G.11R  <>  r^L  THtN 

^■^^  ^  1^:^  •^^  IF  GDIK-C0:.DE0VBLK  >=  LASTBLK  THEfj 

656  1  12:5  32  -itolN 

6i7  1  12:4  32  CLEARLIfJE; 

653  1  12:4  05  WRITECMESSX.'  • ♦ GDIR^C 0 3. DlOVBLK t •  'iMESSa,'  ?  (Y/N)  •); 

659  1  12:4  IQO  OK  :=  NGETCHARCTRUE) ; 

^°^  i  12:4  107  NBLOCKS  :=  GDIR'^C  0  a.DEOVBLK 

661  1  12;3  112  EmD; 

662  1  12:1  114  IF  NOT  OK  THEN 

663  1  12:2  119  aEGlM 

664  1  12:3  119  CLEARLINE; 

665  1  12:3  122  Ii/RIT£(MESS3,»  7  M? 

666  1  12:3  144  READLN(lMBLOCKS)  ; 

667  1  12:3  157  IF  NBLOCKS  <  LASTBLK  THEN 
66a  1  12:4  163  BEGIN 

669  1  12:5  163  CLEARLINE! 

670  1  12:5  166  WRITE(»INVALID  U*)\ 

671  1  12:5  185  EXIT(CALLPROC) 

672  1  12:4  189  end; 

673  1  12:2  189  END 
67<+  1  12:0  139  END; 

675  1  12:0  202 

676  1  12:0  202  C  ASCERTAINS  IF  THE  USER  REALLY  WANTS  TO  DESTROY  THE  DIRECTORY  OF  A  DISK  2 
eil  1  12:0  202  C  IF  THE  USER  DOESN'T  THIS  PROCEDURE  WILL  RETURN  TO  THE  FILER  PROMPT  LINE  : 

678  1  13:d  1  PROCEDURE  RISKVOLUME; 

679  1  13:o  0  BEGIN 

^?0  1  13:i  0  IF  (LASTSTATE  =  oKDIR)  AND  (GDIR  <>  NIL)  THEN 

681  1  13:2  9  BEGIN 

682  1  13:3  9  CLEARLINE; 

683  1  13:3  12  WRITE( 'DESTROY  ',GVID,':  ?  •); 

684  1  13:3  53  IF  NOT  NGETCHAR(TRUE)  THEN 
6Q5  1  13:4  61  EXIT(CALLPROC) 

686  1  13:2  65  END 

687  1  13:0  65  END; 

688  1  13:0  78 

689  1  13:0  78 

690  1  13:0  78  C$1  FILER, A. TEXT] 
690  1  13:0  78  C$1  FILER. B. text: 

til  }  ll'°  ^^  ^      COPYRIGHT  (C)  1979  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA,      3 

6^2  1  13:0  78  Z               PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-       3 

°^^  ^  ^3:0  78  L      TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE      D 


79 


oS^ 

1 

13:j 

7J 

b95 

1 

13  :u 

73 

o9o 

i 

lb'.'] 

7'J 

b3  7 

1 

13:0 

7.^ 

o3^ 

1 

13:  J 

78 

ol9 

i 

13: 'J 

73 

70a 

1 

13:!) 

76 

701 

1 

i3:o 

73 

702 

1 

i4:o 

1 

71)3 

i 

14:  J 

3 

704 

1 

14:d 

3 

7U5 

1 

14:j 

3 

70S 

1 

14:d 

17 

707 

1 

i4:o 

0 

703 

1 

i4:i 

0 

709 

1 

I4:i 

15 

710 

1 

14:2 

22 

711 

1 

i4:i 

27 

712 

1 
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94 
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1 
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94 
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1 
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SPECIAlIZCO    FILER    ROUTIfsiES 
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C  ASCERTAINS  WHETHER  OR  NOT  THE  PROPER  DISK  IS  IN  THE  PROPER  DRIVE  2 

C  IF  IT  IS  NOT  WILL  ASK  USER  TO  PUT  THE  DISK  IN  THE  PROPER  DRIVE  2 

C  IF  THE  USlR  JOES  NUT  DO  SO  THIS  PROCEDURE  WILL  RETURN  TO  THE  1 

L    FiLtR  PROMPT  LINE  3 

PROCEDURE  INSERTVOLUMEdNTUNIT  :  INTEGER;  VIDl  :  VIDJ  CHECK  :  BOOLEAN); 
VAR 

OK  :  BOOLEAN; 

oldUnit,  newunit  :  vio; 

BE3IN  C  INSERTVOLUML"  1 
OLDUi^JlT  :=  •#   •; 
IF  (InTUNIT  DIV  10)  =  1  THE^yl 

0L0UIMITC2D  :=  'l'; 
OLDUr-jiT  C3:  :=  CHRtORDCOM  +  INTUNIT  MOD  10); 
EATSPACES(OLDUNIT) 5 
OK  :=  CHECK; 
IF  CHECK  THEN    £    NEED  TO  MAKE  SURE  THE  DISK  IS  IN  THE  DRIVE  D 

IF  V0L3EARCH(VID1»TRUE»GDIR)  <>  INTUNIT  THEN   C  VOLUME  IN  PROPER  DRIVE  D 

C  KLUDGE  !!!!•!  FORCE  THE  OP-SYSTEM  TO  LOOK  AT  THE  CORRECT  UNIT  2 
C  IF  THERE  ARE  TWO  VOLS  WITH  THE  SAME  NAME  ON  LINE  IT  WON'T  BE  2 
L  ABLE  TO  FIND  THE  ONE  ON  THE  LOWER  DRIVE  OTHERWISE  2 

3lgi:j   c  volume  was  not  in  proper  drive,  where  is  IT  ?  :i 
NEi^iuNiT  :=  oldunit; 

ok  :=  volsearch(Newunit,true.gdir)  <>  o;  c  0  means  unit  not  found  2 
OK  :=  OK  and  (Newunit  =  vidd  c  is  this  the  correct  volume  ?  : 

EN^; 

IF  NOT  OK  THEN 

C  REPEAT  THE  ABOVE  AFTER  ASKING  THE  USER  TO  PUT  IN  THE  CORRECT  DISK  2 

3E3IN 

clearline; 

^RITELNCPUT    •tVlDl.':     IN    UNIT    ', OLDUNIT); 
'MSPACEWAITCTrUL)  ; 
IF    CHECK    THEN 


73b 
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737 
738 
739 
740 
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742 

743 

744 

745 

746 
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748 

749 
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754 

755 

756 

757 
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759 

760 

761 

762 

763 

764 

765 

766 

767 

768 

769 

770 

771 

772 

773 

774 

775 
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I 
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1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


14.*  4 

i  ■+ :  b 
14: 3 
14  :& 
14:4. 


14 
14 
14 
14 
14 
15 
15 
15 
15 
15 

15:2 
15:2 
15:2 
15:3 
15:3 
15:3 
15:4 
15:5 
15:6 


15 
15 
15 
15 
15 
15 
15 
15 
15 
16 

16  :d 
16:d 
i6:o 
i6:i 
i6:i 
16:1 
16:2 


lol 

Ibl 

175 
13o 
133 
130 
190 

202 
202 
1 
9 
9 
0 
Q 
14 
14 
14 
14 
20 
^0 
25 
25 
41 
50 
62 
65 
65 
67 
67 
82 
82 
82 
3 
31 
31 
0 
0 
31 
37 
43 


BEGIN 

JK  :=  (VOLSEARCH(OLDUNlTiTRUE,GDIR)  <>  0); 
It-  (■■jOT  OK)  OR  (OlDJ-'JIT  <>  VIDI)  THEW 
EXIT(CALLPROC) 

EInIO 
END  C  IWSERTVOLUME  1\ 

C  SCANS  THROUGH  DIpNAP  FOR  FILES  TO  BE  DELETED  AND  UPDATES  THE  2 
C  DIRE-TORY  ON  THE  SOURCE  UNIT  CORRESPONDINGLY  3 

PROCEDURE  ZAPENTRlEStDIRMAP  :  3IT|VIAP;  UPDATE  :  BOOLEAN); 

V  AR 

Loc  :  integer; 

BEGIN 

IF  DlRi^lAP.  entries  >  0  THEij 
BESIN 

C  MAKE  SURE  THAT  THE  CORRECT  DISK  IS  IN  THE  DRIVE  3 
INSERTV0LUME(S0URCEUNIT,S0URCEVID,TRUE); 

IF  GDIR  0  iMiL  THEN 
BEGIN 

FOR  LOC  :=  GDIR*  C 0 J.DNUMFILES  DOWNTO  1  DO 

IF  DIRMAP.DIRENTRY  CLOCD  THEN 
rr  MDnA^''^^T^'^°^'^°^^''  ^    DELETES  FILE  AT  LOC  IN  THE  DIRECTORY  1 

UPDATEDIK  I    WRITES  THE  DIRECTORY  OUT  TO  DISK      2 

END 
END; 


END; 

C  PUR 
C  FIL 
FUNCT 
VAR 

GFI 
BEGIN 
RES 
PUR 
IF 
B 


GeS  THE  FILE  REQUESTED  BY  NAME  FROM  THE  DIRECTORY.  IF  THE  3 
E  EXISTS  AND  MESS  <>  •'  THEN  nilLL  ASK  YOU  TO  CONFIRM  ] 
Ion  PURGEIT(NAMt»MESS  :  SHORTSTRIfJG)  IBOOLEAN; 

3  :  FILE; 

ET(GFIB.NAME) ; 

GEIT  :=  lORESULT  =  0; 

lORESULT  =  0  THEN   C  RESULT  OF  0  MEANS  THAT  THE  FILE  WAS  FOUND  1 

Eg  IN 
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111 
713 
7  79 
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799 

800 
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802 

303 
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aoo 

807 

803 
809 
810 
all 
312 
813 
814 
815 
316 


1 

1 

i 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

i 

1 


lb, 

1&: 

is; 

16; 

16: 

i&: 

16: 

16: 

16:6 

16:4 

16:3 

16:3 

16:2 

i6:o 

16  :o 
16:q 

17  :d 
17:o 


17 
17 
17 
17 
17 
17:2 

17:3 

I7:i 

i7:o 

i7:o 

i7:o 

17: 0 

i7:o 

i7:o 

i7:o 

17: 0 

18  :d 

18:d 

18  :o 

18  :d 

18:d 

18:d 

i9:[j 


M3 
b2 
5^ 
bb 
:?4 
102 
1U2 
105 
109 
109 
109 
115 
117 
119 
138 
138 
1 
0 
0 
13 
44 
58 
58 
62 
73 
93 
123 
136 
136  C 
136 
136 
136 
136 
136 
1 
3 
27 
27 
28 
29 
1 


END; 


:l 

CH 

END; 


IF     Mr:SS    <>     ♦♦     THEN 
3l5I;\J 

CLZARLlr.Jc; 

"VRITE(  ^i:SS»  '     'iNAMEf' 

IF    rJOT     ^IGETCHAR(TRUE) 

PU.-^GEir  :=  FALSE; 

EXIT(PURGEIT) 

Ergj 
end; 
ose(gfis. purge) ; 

tCKRSLT(IORESULT) 


?  M 

THEN 


C  USER  DOES  NOT  WISH  TO  REC^OVE  THE  FILE  2 


E  LETS  USER  KNOW  WHAT  IS 
PROCEDURE  PRINTMESS(VID1 
BEGIN 

clearlinl"; 

WRITL(\/lDlt':',TlDl)  ; 
IF  (LENGTH(DEST)  +  31) 

writeandclear 
else 

IF  NOT  SYSCOM-.MISCINFO.SLOWTERM  THEN 

WRITEC»:24-(LENGTH(VI01)+LENGTH(TID1))); 
WRITelNC  -->  '.DEST)  ^xw/, 

END; 


BEING  DONE  TO  HIS  FILE  1 

:  VID;  TIDl  :  TID;  DEST  :  SHORTSTRING); 


>  SYSCOM'^.CRTINFO, WIDTH  THEN 


COMMAND  PARSERS  &    DIRECTORY  SEARCH  ROUTINES 3 


PROCEDURE  SCANINPUT(GTITLE  :  STRNG;  CHECK TcHCKsJ  ^ 

VAR  ^^^^^    '     If^TE^SER;  WHERE  :  LOCATION;  GETDIR  :  BOOLEAN)! 

NEWDiR  :  ^integer; 

GSEGs  :  INTEGER; 


PROCEDURE  MAKECALL(ERR  :  INTEGER;  STATE  :  CHECKS); 


817 

1 

i^:d 

5 

dia 

i^:j 

3 

819 

i9:o 

4- 

320 

i^:o 

0 

321 

19: 1 

0 

822 

i9:i 

3 

823 

19:2 

17 

32'+ 

I9:i 

21 

825 

19:2 

31 

826 

I9:i 

35 

827 

i9:i 

38 

823 

19  :i 

40 

829 

i9:i 

40 

830 

i9:i 

40 

331 

19:2 

49 

832 

19:3 

49 

833 

19:3 

57 

834 

19:4 

66 

835 

19:3 

74 

836 

19:2 

92 

837 

i9:i 

92 

838 

19:2 

94 

839 

19:3 

103 

B'+O 

19:3 

113 

S'+l 

19:1 

113 

8'f2 

I9:i 

123 

a^z 

19:2 

132 

844 

i9:i 

145 

845 

19:2 

147 

846 

i9:i 

149 

847 

i9:i 

153 

848 

i9:i 

153 

849 

i9:i 

153 

850 

i9:i 

156 

851 

i9:i 

161 

852 

I9:i 

180 

853 

i9:i 

202 

854 

i9:i 

224 

855 

i9:i 

241 

356 

i9:i 

270 

857 

19:2 

281 

VAR 

PRIMTERROR     :    SOOLtlAN; 

rlLGlri 

LASTSTATE  :=  STATE; 

IF  (STATE  IM  CHECK)  OR  (ERROR  =  0)  THEN 

EXIT(SCANINPUT) ; 
IF  GTITLE  =  "  THEN 

EXIT(CALLPROC) 5 
HOrJIECURSOR; 
WRITEANDCLEAR; 

C  WRITES  OUT  THE  EXPLICIT  VOLUME  NAME  1 
IF  GTITLE  Lll    =  '*♦  THEN 
3E6IN 

delete(gtitle:,i,i)5 

IF  GTITLE  CIJ  =  »:•  THEN 

DELETE(GTITLE,1,1) ; 
WRITE(SYVID» •:• ) 
END 
ELSE 

IF  GTITLE  C13  =  •:•  THEN 
WRITECDKVID) ? 

WRITE(GTITLE) ; 

IF  SYSCOW^.CRTINFO, WIDTH  >=  80  THEN 
WRITEC  -  •) 

ELSE 

writeandclear;.  :  write  string  in  error  2 

MESSAGES(ERR»FALSE);  c  WRITE  THE  STATE  OF  THE  STRING  3 

C  WAS  THE  USER  EVEN  CLOSE  TO  THE  CORRECT  FORMAT  3 
CASE  STATE  OF 

3A0TITLE  :  PRINTERROR  :=  TRUE; 

NOVOLtBADUNlTfBADDIR  :  PRINTERROR  :=  (ERR0R=FILEEXP)  AND  (GTlD=»M; 

JN8LKDV0L  :  PRINTERROR  :=  ERROR  IN  CBLKDEXP.FILEEXP.FILEBLKDEXPD; 

OKFILE.BADFILE  :  PRINTERROR  :=  ERROR  IN  CBLKDEXP,UNBLKDEXPf V0LEXP3; 

OKOIR  :  PRINTlRROR  :=  error  in  CUNBLKDEXPtFlLEEXPtFILEUNBLKOEXPD 

ENo; 

IF  NOT  SYSCOM'^.MISCINFO.SLOWTERM  THEN 
3EGIN 


88 


34 


853 

19:3 

^n 

ao':* 

19:h 

>  h4 

660 

19:  b 

2U4 

661 

19  :o 

P93 

362 

19:5 

255 

863 

19:6 

297 

36'+ 

19:5 

309 

865 

I9:i+ 

313 

Otsb 

19:h 

315 

867 

l9:^ 

315 

86b 

19:3 

315 

369 

i9:i+ 

322 

870 

19:3 

341 

871 

19:^+ 

34  3 

372 

19:2 

365 

373 

i9:i 

365 

87'+ 

i9:o 

369 

375 

i9:o 

332 

876 

i8:o 

0 

877 

i8:i 

0 

878 

i8:i 

8 

379 

18:2 

25 

880 

18:3 

25 

881 

18:4 

28 

882 

18:3 

32 

833 

18:3 

38 

88'+ 

18:3 

50 

885 

18:4 

55 

386 

18:5 

55 

837 

18:6 

60 

339 

13:5 

dH 

669 

18:5 

67 

890 

18:6 

73 

891 

18:5 

77 

892 

18:6 

66 

893 

18:5 

92 

39^ 

18:4 

96 

895 

18:3 

93 

69b 

18:4 

107 

397 

18:3 

113 

898 

18:4 

126 

IF    PkliiTEi^ROK    THEfJ 
■iEGIM 

IF    SYSCUi^'^.CRTIiJFQ.wIOTH    <    80    THEN 

WKITEANDClEaR 
ELSE 

^RlTECt  •); 

MESS AGES (ERROR. FALSE) 
£MD; 

C  JSER  MAY  NEED  TO  KNOW  WHICH  PART  OF  THE  STRING  IS  IN  ERROR  3 
IF  WHERE  c  SOURCE  THEN 

^RITEC  <30URCE>'); 
IF  WHERE  =  DESTINATION  Tf^EN 

^RITEC  <DEST>M; 
END; 

exit(callproc) 
end: 

begin  c  scaninput  2 

GUNIT  :=  o; 

IF  SCANTlTLE(GTlTLE,GVlD»GTlDtGSEGS,GKlND)  THEN  C  BREAK  UP  INPUT  STRING  1 

3EGIN 

IF  GETOIK  THEN 

MARK(NEWDIR) ;     C  WILL  CAUSE  THE  PRESENT  DIRECTORY  TO  DISSAPPEAR  2 
GVID2  :=  GVID!      L    SAVE  PRESENT  GVID  2 

GUNIT  :=  VOLSEARCH(GVID.TRUEiGDlR) ;   C  SEARCHS  FOR  PROPER  VOLUME  1 
IF  GDIR  =  NIL  THEN    C  WASN'T  ABLE  TO  READ  A  DIRECTORY  OFF  THE  VOLUME 
BEGIN 

IF  GJNIT  =  0  THEN 

MAKECALLO.NOVOl)  ;    C  no  such  vol  was  ON-LINE  1 
UNITCLEAR(GUNIT) ; 
IF  lORESULT  <>  0  THEInI 

MAKECALL(2,BADUnIT) ;  C  BAD  UNIT  U    GIVEN  3 
IF  UNITAELE  C GUNIT D. UISBLKD  THEN 


MAKECALL(N0DIR»3ADDIR) : 
MAKECALL(UN8LKD,UNBLKDV0L) 
END; 
IF  GTID  =  •♦  THEN 

:^AKECALL(BLKU,0KDIR)  ;   C  VOL 
IF  DlRSEARCH(GTID,TRUEtGDIR)  <> 
MAKECALL(FOUNDFILE.OKFILE) ; 


C  VOL  WAS  BLKD.  BUT  NO  DIR 
C  VOLUME  WAS  NOT  BLOCKED  1 


WAS  BLKD  g    THE  DiR  IS  OK  3 
0  THEN 
:  THE  FILE  WAS  FOUND  J 


WAS  ON  IT  2 


899 
90  J 
901 
90^ 
90  3 
90^+ 
905 
906 
907 
903 
909 
910 
911 
912 
913 

9m 

915 

916 

917 

918 

919 

920 

921 

922 

923 

921 

925 

926 

927 

928 

929 

930 

931 

932 

933 

931 

935 

936 

937 

938 

939 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


18 

18 

1 8 

16 

18 

18 

18 

13 

18 

18 

18 

20 

20 

20 

20 

20 

20 

20 

20 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 


2 
1 

U 
0 
0 

n 

'J 

D 
0 
0 
D 
0 
D 
D 
D 
0 
D 
0 
D 
0 
1 
2 
3 
3 
3 
3 
3 

5 
5 
6 
5 
5 
5 
6 
5 
5 


132 
131 
136 
140 
154 
154 
154 
154 
154 
154 
154 
3 
5 
2d 
28 
29 
37 
37 
37 
1 
0 
0 
9 
9 
16 
53 
56 
59 
71 
71 
74 
85 
103 
126 
134 
145 
151 
163 
163 
163 
163 


^iake:call(io,baufile)   i:   the  file  was  not  fou^nid   3 

MAK_CALL(ILLFILEV0L,3ADTITLE)  C  ILLEGAL  NAME  (TOO  LONGf  OR  MISSING  BRACKET  J 
ElviD  C  SCANINPUT  1; 


OIKECTORY  SEARCH  ROUTINE  FOR  FINDING  THE  USER  REQUESTED  FILES 
ON  The  FIRST  CALL  TO  THIS  ROUTINE  ALL  TABLES  AND  NECCESSARY 
3ITS  IN  THE  DIRECTORY  WILL  3E  UPDATED  TO  KEEP  TRACK  OF  THE 
NESCESSARY  FILES,  WITHOUT  LOSING  ANY,  ALL  FILES  THAT  ARE  TO 
BE  USED  IN  WILDCARD  OPERATIONS  iMUST  BE  PRESENT  ON  THE  INITIAL 
INITIAL  CALL  TO  THIS  ROUTINE 
FUNCTION  SEARCHDIR(MESSAGE  :  STRNG;  VAR  GINX  I  INTEGER; 

DESTf  SCREENCLEAR  :  BOOLEAN)  :  BOOLEANJ 
VAR 

X  :  integer; 

NEWSTRING  :  TID; 

C  AT  THIS  POINT  A  REQUESTED  FILE  HAS  BEEN  FOUND.  IN  CASE  THAT     3 
Z    QUESTION  IS  TRUE  WE  MUST  SEE  IF  THE  USER  STILL  WANTS  TO  USE  IT  ] 
PROCEDURE  FOUNDFILE; 
BEGIN 

WITH  GDIR"  CGINX]  DO 
BEGIN 

SOURCETITLE  :=  DTID; 

FROMWHERE  1=  CONCAT( VOLNAMEl , • ! • , DTiD ) ; 
CH  :=  ♦Y*; 

FOUND  :=  FILEFOUND;      C  yes  a  USABLE  FILE  HAS  BEEN  FOUND  2 
IF  (MESSAGE  <>  ♦•)  AND  QUESTION  THEN  C  CONFIRM  OPERATION  2 
BEGIN 

CLEARLINE; 

IF  NOT  SYSCOM^.MISCINFO.SLOWTERM  THEN 

WRlTE{MESSAGEi •  ♦); 
WRITE(DTlDf'  ?  •); 
CH  :=  GETCHAR(FALSE) ; 
IF  NOT  EOLN  THEN 

WRITELN; 
IF  CH  =  SYSCOM'^.CRTINFO.ALTMODE  THEN  C  USER  WANTS  TO  ABORT  1 

C  DON'T  RETURN  TO  PROMPT  LINE  BECAUSE  OF  THE  R(EMOVE  COMMAND  2 

BEGIN 

FOUND  :=  abortit; 


y+u 

2l;7 

loo 

5'+l 

21:6 

170 

9^-2 

21  :<+ 

170 

9<+3 

21:2 

17: 

9'+'+ 

21:1 

170 

9'+5 

21:0 

171 

9'+6 

21:0 

168 

947 

21:0 

188 

9'+3 

22  :d 

3 

949 

22  :d 

13 

950 

22:j 

13 

951 

22:0 

0 

952 

22:1 

0 

953 

22:1 

13 

954 

22:1 

31 

955 

22:0 

33 

956 

22:0 

52 

957 

20:0 

0 

958 

20:1 

0 

959 

20:1 

3 

960 

20:2 

14 

961 

20:3 

14 

962 

20:3 

25 

963 

20:4 

30 

964 

20:5 

30 

965 

20:5 

33 

966 

20:4 

33 

967 

20:3 

39 

968 

20:3 

42 

969 

20:3 

42 

970 

20:3 

42 

971 

20:3 

42 

972 

20:5 

52 

973 

20:3 

52 

974 

20:3 

52 

975 

20:4 

70 

976 

20:5 

77 

977 

20:6 

77 

978 

20:6 

85 

979 

20:7 

104 

93  0 

20:7 

112 

c30 


r',XlT(SEARCHDIR) 

EiNiC 
tiJO; 

SEIARCHDIR  :=  CH  =  'Y* 
EN3; 

C  Cf^ECKS  TO  SEE  IF  THE  REQUESTED  PORTION  OF  THE  TWQ  STRINGS  MATCH  J 

FUNCTn\'  TESTSTR(STR  :  TID;  START  :  INTEGER)  :  BOOLEAN; 

VAR 

TEMP  :  TID; 

3EGIN 

TEMP  con  :=  STR  CO  J; 

"•io\/Eleft(gdir'*  cx:i.dtidcstart:,tempcid.length(str)); 
teststr  :=  temp  =  str 

END; 

BEGIN  c  searchdir  : 
searchdir  :=  false; 

IF  GINX  =  0  then 

begin 
OEST  :=  DEST  AND  unitable  cdestunit:.uisblkd ; 

IF  SCREENCLEAR  AND  WILDCARD  THEN 
BEGIN 

CLEARSCREEN; 
WRITELN 

end; 
FOUND  :=  nofiles; 

C  WILL  IT  BE  NESCESSARY  TO  USE  THE  STATUS  BITS  IN  THE  DIRECTORY  2 
C  TO  KEEP  PROPER  TRACK  OF  THE  FILES  j 

MARKING  :=  DEST  AND  (SOURCEVID  =  DESTVID); 

C  SEARCH  DIRECTORY  FOR  ELIGIBLE  SOURCE  FILES  ] 
FOR  X  :=  1  TO  GDIR'*  COD.DNUMFILES  DO 
WITH  GDIR'*  Cxn  DO 
BEGIN 

STATUS  :=  FALSE; 

IF  (LENGTH(STRINGl)  +  LENGTH ( STRING2 ) )  <=  LENGTH(DTID)  THEN 
IF  TESTSTR(STRING1,1)  AND 

TESTSTR(STRlNG2iLENGTH(DTID)  -  LENGTH { STRING2)  +  1)  THEN 


9di 

20  :d 

16^ 

982 

2  0 :  -? 

13^ 

333 

21 : 1 

iJi't 

3<i^ 

2o:i 

147 

98  5 

2c:2 

147 

986 

20:2 

155 

987 

20:2 

164 

988 

20:1 

176 

9d9 

20:0 

17o 

990 

20:9 

176 

991 

20:5 

179 

992 

20:3 

187 

993 

2d:^ 

190 

ggif 

20:2 

190 

995 

20:1 

192 

996 

20:2 

194 

997 

20:3 

197 

998 

20:1 

203 

999 

20;  2 

212 

1000 

20:3 

212 

1001 

20:3 

218 

1002 

20:3 

221 

1003 

20:^ 

236 

lOOtt 

20:5 

245 

1005 

20:6 

245 

1006 

20:6 

251 

1007 

20:7 

254 

looa 

2o:a 

254 

1009 

2o:s 

269 

1010 

20:9 

278 

1011 

20:0 

278 

1012 

20:0 

286 

1013 

20:9 

286 

101*^ 

20:7 

288 

1015 

20:6 

288 

1016 

20:7 

298 

1017 

20:6 

290 

1018 

20:9 

301 

1019 

20:0 

301 

1020 

2o:q 

316 

1021 

20  ;o 

340 

WITH  DIKMAP  00 

BEGIN   c  THIS  FILE  MATCHES  THE  NESCESSARY  STRINGS  1 
IF  (STRIMG1  =  DTI0)  OR  k^ilLDCARD  THEN 
BEGIN 

STATUS  :=  marking; 

DIRENTRY  CXD  ;=  TRUE; 
ENTRIES  :=  ENTRIES  +  l; 

END; 
found  :=  filesnogood 
end; 
end; 
if  marking  then 

END  ^""^^^^^^^      ^  "^^"^  MAINTAIN  THE  STATUS  BITS  IN  THE  DIRECTORY  2 
ELSE 

IF  DEST  THEN 

GINX  :=  GINX  -  i; 
IF  DIRMAP. ENTRIES  >  0  THEN 
BEGIN 

INSERTJ/OLUME(SOURCEUNIT,SOURCE\/ID,TRUE)I  C  GET  THE  SOURCE  VOLUME  ON-LINE  3 

WHILE  (GINX  <  GDIR'^COD.DNUMFILES)  AND  (CH  <>  »Yt)  nn 
WITH  GDIR'^  CGINX  +  ID  DO 
BEGIN 

GINX  :=  GINX  +  i;  C  LOOK  AT  THE  NEXT  DIRECTORY  ENTRY  3 

BEGIN 

DIRMAP. DIRENTRY  CGINX3  :=  STATUS; 
IF  STATUS  THEN 
BEGIN 

UPDATEDIR  ''*'"^^''    ^    '^^^^    ^^^    SlI^WS    BIT  IN  DIRECTORY  1 

END 
END; 

IF  DIRMAP, DIRENTRY  CGINXD  THEN 

^^?p\c-cT^ST^^  ^^^^    ^^^    ^^^S  ^"^^f^Y  IS  O.K.  WHAT  ABOUT  DEST  D 
•i '  UE'S  '  THt-N 

BEGIN 

NEWSTRING  :=  COPY ( DTiD* LENGTH ( STRINGl )  +  1, 

LENGTH(DTID)  -  LENGTH(STRING1 )  -  LENGTH( STRING2) ) { 
X  :=  LENGTH(NEWSTRING)  +  r^x.Ma*:i/, 


87 


3S 


1022 

20:u 

3  4 '4 

1023 

2o:o 

364 

102^+ 

2o:o 

370 

1025 

2'j:o 

3  7c. 

102b 

20  :i 

37*3 

1027 

20;2 

3  78 

1028 

20:2 

412 

1029 

20:2 

430 

1030 

20:3 

443 

1031 

20:1 

443 

1032 

20:0 

445 

1033 

20:1 

447 

lQ3if 

20:9 

472 

1035 

20:8 

472 

1036 

20:9 

474 

1037 

20:8 

476 

1038 

20:8 

485 

1039 

20:7 

497 

1040 

20:5 

497 

lOfl 

20:2 

499 

ic+a 

20:1 

499 

10^+3 

20:2 

505 

104tf 

20:1 

509 

lO^tS 

20:2 

515 

1046 

20:0 

521 

1047 

20:0 

548 

1048 

20:0 

548 

1049 

20:0 

548 

1050 

20:0 

548 

1051 

23:d 

1 

1052 

23:d 

5 

1053 

23:d 

34 

1054 

23  :d 

34 

1055 

23:d 

75 

1056 

23:d 

75 

1057 

23:d 

75 

1058 

23:d 

75 

1059 

23:d 

75 

1060 

^4:d 

1 

1061 

24:d 

<+ 

1062 

24:o 

2J 

iiCAU(Li:rjGTH(STKING3)  .=    •  C  »  f  STRINGSC  1  3  )     +    LENGTH  (  STRING4  )  ? 
IF     (X    <=    TIDLEMG)    AND     ((X    >    0)     OR    NOT    WILDCARD)     THEN 

i:  DESTINATION  FILE  wILL  BE  O.K.  (ITS  SMALL  ENOUGH  )  3 
BEGIN 

TOWHERE  :=  C0NCAT{V0LNAME2. • : • tSTRING3, 

NEWSTRING.STRING4) I 
IF-  (STRINGl  =  DTID)  OR  WILDCARD  THEN 
FOUNDFILE 
END 
ELSE 

PRINTMESS(SOURCEVlD.DTIDt 'NOT  PROCCESSED» ) ; 
END 
ELSE 

FOUNDFILE;   [  NO  DESTINATION  FILE  IS  NEEDED  3 
DIRMAP.DIRENTRY  CGINX3  :=  FALSE;  L    TURN  OFF  BIT  FOR  THIS  ENTRY  3 
DIRMaP. ENTRIES  :=  DIRMAP, ENTRIES  -  1;  C  ONE  LESS  ENTRY  TO  DO  1 

end; 
end; 
end; 
IF  Found  =  nofiles  then 

messages(0rd(ln0file) ffalse) ;  c  no  requested  files  were  found  3 
if  Found  =  filesnogood  then 

MESSAGES(BADDEST. FALSE) ;  Z    THE  REQ.  FILES  FOUND  COULD  NOT  BE  USED  3 
END  C  SEARCHDIR  3; 


C  INPUT  STRING  PARSER.  REMOVES  WILDCARD  SYMBOLS. 
C  EXPA^JDS  DOLLAR  SIGNS,  SETS  SOURCEVID,  DESTVID* 
C  VOLNaiwEI,  V0LNAME2t  STRINGl.  STRING2,  STRING3. 
PROCEDURE  CHECKFlLE(MSGl.MSG2  :  SHORTSTRING;  DEFAULT. ERRORl 

WILD,FILLE  :  boolean;  CHECKl  :  CHCKS); 
VAR 

SRCSTK  :  STRING; 


SETS  WILDCARD  AND  QUESTION  3 
SOURCEUNIT,  DESTUNIT,  3 
STRING4  3 

INTEGER; 


C  WI.L  SCAN  UP  TO  THE  NEXT  ♦.«  OR  TO  THE  END  OF  THE  LINE.  DOES  ALL  »$•  3 

C  EXPANSIONS.  PARSES  STRING  FOR  WILDCARDS.  VOLNAME  S  FILENAME,  MAKES  3 

C  SU^E  THAT  THE  SOURCE  AND  DEST  FILES  ARE  OF  THE  APPROPRIATE  CLASS  AND  3 

C  TH.AT  NEEDED  VOLUMES  STAY  ON  LINE  3 

PROCEDURE  processdata(Msg:shortstring;  firstcall:boolean;  var  volname:vid; 

VAR  firststr,secondstr:shortstring;  var  WHERET0;STRNG) ; 

VAR 


iO&5 

■j 

24;q 

20 

1064 

2'+:d 

1G2 

lObb 

2'+:  J 

11j3 

IO60 

2^:d 

i  U  0 

1067 

24:0 

10b 

1063 

24  :d 

IGS 

1069 

24:d 

1G6 

1070 

24  :d 

106 

1071 

25:d 

1 

1072 

25:0 

4 

1073 

25:d 

4 

1074 

25:d 

5 

1075 

25:d 

5 

1076 

26:o 

3 

1077 

26:o 

0 

1078 

26:i 

0 

1079 

26:o 

12 

1080 

26:o 

3D 

1081 

25:o 

0 

1032 

25  :i 

0 

1083 

25  :i 

17 

108*+ 

25:i 

24 

1085 

25:i 

34 

1086 

25:i 

42 

1087 

25:2 

64 

1088 

25:1 

68 

1089 

25:i 

71 

1090 

25:2 

82 

1091 

25:i 

90 

1092 

25:2 

99 

1093 

25:i 

101 

109f 

25:2 

104 

1095 

25:i 

127 

1096 

25:i 

130 

1097 

25:1 

153 

1098 

25:i 

178 

1099 

25:i 

200 

1100 

25:1 

214 

1101 

25:2 

217 

1102 

25:3 

217 

1103 

25:4 

222 

str^olo  :  string; 
WHERE  :  location; 
x.i.LOc  :  intlger; 

L  MAKES  SURE  THAT  THE  STRUCTURE  BEFORE  THE  LAST  DELIMMITER  IS  oF  THE 

C  APPROPRIATE  SI^^E  &    CONTAINS  NO  SPECIAL  SYMBOLS.  IF  FOR  ANY  REASON 

C  THE  STRING  Is  NOT  CORRECT  AN  ERROR  WILL  BE  FLAGGED  AND  THIS 

Z    PROCEDURE  WILL  RETURN  TO  THE  FILER  PROMPT  LINE 

PROCEDURE  FINDDELIM(SIZE. MESSAGE  :  INTEGER;  VAR  STRUNG  :  STRNG); 

\/ar 

ERROR  :  BOOLEAN; 


C  SCANS  STRUNG  FOR  THE  APPROPRIATE  SPECIAL  SYMBOL 

FUNCTION  SCAN2(CH  :  CHAR)  :  BOOLEAN; 

BEGIN 

SCAN2  :=  SCAN(LOC,=  CH, STRIINGC13)  = 

END; 


C'$» 


♦»?»f »=»3 


LOC 


BEGIN  C  FINDDELIM  D 

STRUNG  :=  C0PY(STR,1,L0C);    C 
ERROR  :=  LOC  >  SIZE;  C 

DELETE(STR»1,L0C)  ; 
0ELETE<STR.1,1J ; 

IF  (NOT  ERROR)  AND  SCAN2(»$M  AND 
EXIT(FINDDEHM)5     C  NO  ERRORS 

clearline: 

IF  NOT  SYSCOM'^.MISCINFO.SLOWTERM  THEN 
WRITE(STRIING) ; 

IF  SYSCOM^.CRTINFO. WIDTH  <  80  THEN    C 

WRITEANDCLEAR; 
IF  ERROR  THEN 


RETURNS  CORRECT  PORTION  OF  THE  STRING  2 
TOO  LONG  TO  BE  A  LEGAL  ENTRY  2 


SCAN2('=«)  AND 
ENCOUNTERED  2 


SCAN2(»?»)  THEN 


LINE  WILL  NOT  FIT  IN  40  CHARS.  2 


WRITE( 


.TOO  LONG  <•) 


MESSAGE  OF 
:  WRITE(t  FILE 
:  WRITE(» 
WRITEC 


NAME  • ) ; 
SCAN  STRIi^G  ♦) 
VOL  NAME  •) ; 


CASE 
1 
2 
3 

END; 

IF  ERROR 
BEGIN 

IF  MESSAGE  =  3  THEN 
WRITE(VIDLENG) 


THEN 


8W 


90 


110£+ 

25:5 

230 

110b 

ib:^■ 

232 

1106 

25:3 

240 

1107 

25:^ 

264 

11Q9 

25:i 

261 

110  9 

2b:2 

26d 

1110 

25:i 

292 

1111 

25:0 

296 

1112 

25:g 

308 

1113 

25:o 

303 

lllf 

27:d 

3 

1115 

27:o 

0 

1116 

27:i 

0 

1117 

27:o 

16 

1118 

27:o 

23 

1119 

21:0 

0 

1120 

21:0 

0 

1121 

2'+:i 

0 

1122 

24 : 2 

15 

1123 

2'+:3 

15 

112f 

21:3 

18 

1125 

21:3 

27 

1126 

2«+:i 

32 

1127 

21:5 

37 

1128 

2*+:'+ 

57 

1129 

21:5 

59 

1130 

21:3 

78 

1131 

24:3 

91 

1132 

21:3 

109 

1133 

21:2 

112 

1131 

21:2 

114 

1135 

24:2 

114 

1136 

24:1 

114 

1137 

24:i 

130 

1138 

24:2 

136 

1139 

24:i 

140 

ll^O 

24:i 

157 

111+1 

24:i 

166 

lli+2 

24:i 

174 

111+3 

24  :i 

174 

111+1 

24:i 

174 

WRITE(TIULEM6) ; 
l^/RITE(  '  -  CHAR.  MAX  >•  )  ; 
EN  J 
ELSE 

ifllRITEC-    ILLEGAL    FORMAT'); 
EXIT(CALLPROC) 
END    C    FINDDELIiVi    J; 

C    SCAN    STR    FOR    SPECIAL    SY^IBOLS    C  *$»  t  •  =  •.•?»«•.•  D    1 

FUNCTION    SCANKCH    :    CHAR)     :    INTEGER! 
3ESIN 

SCANl    :=    SCAN(I-ENgTH(STR)  ,    =    CHtSTRC13); 
ENo; 

BEGl;j 

C  NEED  TO  GET  INPUT  STRING  FROM  USER  2 
IF  INSTRING  =  »'  THEN 
BEGIN 

CLEARLINE; 
WRITE(MSG) 5 

IF  FIRSTCALL  and  FAST  THEN 
IF  FILLE  THEN 

WRITE( »  WHAT  FILE') 
ELSE 

WRITE{ »  WHAT  VOL') ; 
WRITEC  ?  •)5 
READLN(INSTRING) ; 
EATSPACES(INSTRING) 
END? 

C  COPY  INPUT  STRING  INTO  STR  UP  TO  THE  FIRST  COMMA  OR  END  OF  LINE  2 
LOC  :=  SCANCLENGTHdNSTRING).  =  '  ♦ »  ♦  INSTRINGC13)  ; 
IF  LOC  >  35  THEN 

EXIT(CALLPROC) ? 
STR  :=  C0PY(INSTKING»1«L0C) I 
DELETE (INSTRINGtltLOC) ; 
OELETE(INSTRINGtltl) 5 

E  PARSE  VOLUME  NAME  OUT  OF  STR.  CHECK  TO  SEE  IF  QUESTION  IS  TRUE  2 
QUESTION  :=  QUESTION  OR  (SCANIC?')  <  LENGTH  ( STR ))  ; 


ll^+S 

1   24;i 

1S3 

il4o 

1   24:1 

195 

llf7 

1    24:2 

2ii 

ii'+a 

1   24:i 

214 

ii'+9 

i   24:2 

21S 

1150 

1    24:3 

226 

1151 

1    24:4 

226 

1152 

1    24:4 

233 

1153 

1    24:3 

254 

1154 

1   24:i 

237 

1155 

1   24:i 

262 

1156 

1   24:i 

262 

1157 

1   24  :i 

262 

1156 

1   24:i 

269 

1159 

I    24:2 

278 

1160 

I    24:3 

278 

1161 

L    24:4 

294 

1162 

I   24;3 

298 

1163    : 

L    24:3 

304 

1164    3 

L    24:3 

320 

1165    ] 

L    24:3 

337 

1166    : 

L    24:2 

366 

1167    j 

L    24:2 

366 

1168    ] 

24:2 

366 

1169    ] 

24  :i 

366 

1170    i 

24:i 

373 

1171    3 

24:i 

380 

1172    1 

24:2 

389 

1173    3 

24:i 

396 

1174    1 

24:i 

405 

1175    1 

24:i 

405 

1176    1 

24:2 

405 

1177    1 

24:3 

410 

1178    1 

24:4 

410 

1179    1 

24:5 

416 

1180    1 

24:4 

422 

1181    1 

24:4 

425 

1182    1 

24:4 

430 

1183    1 

24:4 

436 

1134    1 

24:3 

439 

1135    1 

24:2 

441 

LOc  :=  SCAWK  •:  •  )  ; 

IF  (STR  Ci:  =  •«•)  OR  (LOC  <  LENGTH(STR))  THEN 

FINDjELIi^1(VIDL£:NG,3,\/0LNA^1E) 
ELSE 

IF  STRCID  =  •*•  THEN 
BEGIN 

DELETE(STR»1.1); 
VOLNAME  :=  •*♦ 
END; 
WHERETO  :=  CONCAT{VOLNAME, •: • ) ; 

C  EXPAND  THE  •$•  IF  ONE  EXISTS     1 

I  :=  scANics') ; 

IF  I  <  LENGTHCSTR)  THEN 
3EGIN 

IF  LENGTH{STR)+LENGTH(SRCSTR)-1  >  35  THEN 

EXIT(CALLPROC);     C  ILLEGAL  EXPANSION,  TOO  LONG  1 
OLD  :=  STR; 

STRCOD  :=  CHR(LEN6TH(SRCSTR)+LENGTH(STR)-1)5 
M0VELEFT(SRCSTRC1D,STRCI+13,LENGTH(SRCSTR) ) ? 

M0VELEFT{0LDCI+23»STRCI+1+LEN6TH<SRCSTR>3,LEN6TH(0L0)-I-1); 

END; 

C  SCAN  FOR  WILDCARDS  1 

SRCSTR  :=  STR; 

LOG  :=  SCANK  •  =  •)  ; 

IF  LOC  =  LENGTH<STR)  THEN 

LOC  :=  SCANK  *?»)  ; 
IF  LOC  <  LENGTh(STR)  THEN 

C  WILCARD  SYSM80L  IS  PRESENT.  PARSE  REMAINING  STRING  ACCORDINGLY  2 
IF  WILD  THEN 
BEGIN 

IF  NOT  (FIRSTCALL  OR  WILDCARD)  THEN 
MESSAGES(BADFORM»TRUE) ; 

WILDCARD  :=  true; 

FINDDELIM(TIDLENG,2,FIRSTSTR) ; 
LOC  :=  LENGTH (STR) ; 

FINDDELIM(TIDLENG,2»SEC0NDSTR) 
END 
ELSE 
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116?, 

1 
X 

24:3 

443 

1187 

24  :i 

447 

1138 

24:i 

451 

1189 

24:i 

4bl 

1190 

24:2 

451 

1191 

24:3 

451 

119<: 

24:3 

463 

1193 

24:3 

463 

119'+ 

24:3 

4£>3 

1195 

24:3 

463 

1196 

24:3 

463 

1197 

24:4 

463 

1198 

24:5 

463 

1199 

24:5 

494 

1200 

24:6 

499 

1201 

24:4 

505 

1202 

24:3 

505 

1203 

24:3 

510 

1204 

24:2 

530 

1205 

24  :i 

532 

1206 

24  :i 

536 

1207 

24:i 

536 

1208 

24:2 

536 

1209 

24:3 

536 

1210 

24:3 

546 

1211 

24:3 

549 

1212 

24:3 

555 

1213 

24:3 

555 

1214 

24:3 

555 

1215 

24:2 

561 

1216 

24:i 

561 

1217 

24:2 

563 

1218 

24:3 

579 

1219 

24:2 

579 

1220 

24:3 

584 

1221 

24:3 

587 

1222 

24:3 

587 

1223 

24:i 

567 

1224 

24:2 

590 

1225 

24:i 

602 

1226 

24:2 

606 

MESSA&ES(.J0WILD,TRUE)    C  ^ILCARD  OPERATION  IS  NOT  ALLOWED  3 

ELS- 

C  NO  WILCARJS.  REMAIfJINS  STRING  IS  A  STANDARD  FILENAME  3 
3EGIi^) 

IF  (NOT  FIRSTCALL)  AND  WILDCARD  AND  (DEFAULT  =  0)  THEN 

E  USER  USED  A  WILDCARD  SY^^80L  FOR  THE  SOURCE  FILE  BUT  NOT  THE  3 

L  DESTINATION  FILE.  ONLY  CASES  THAT  THIS  IS  ALLOWED  IS  WHEN  1 

Z    THc  USER  IS  LISTING  THE  DIRECTORY  (I.E.,  DEFAULT  <>  0)  OR  D 

C  WHEN  THE  DESTINATION  FILE  IS  AN  UNBLKD-VOLUME  1 

3  EG  1 14 

SCANlNpUT(CONCAT(\/OLNAME2»»:MfC3»0»NElTHER,FALSE){ 
IF  LASTSTATE  <>  UNBLKDVOL  THEN 
MESSaGES(BADFORM,TRUE) ! 
END; 
FINDDELIM(SHSTRLENG,ltFIRSTSTR); 
WHERETO  :=  CONCAT(WHERETOfFIRSTSTR) 
END; 
IF  NOT  FIRSTCALL  THEN 

C  SET  DESTUNIT  &    DESTVID  TO  THERE  PROPER  VALUES  2 
BEGIN 

SCAN INPUT{wHERETOiCDiO, WHERE ♦ TRUE) ; 
DESTUNIT  :=  eUNiT; 
DESTVID  :=  GVID; 

C  MAKE  SURE  THAT  THE  USER  HASN»T  REMOVED  THE  SOURCE  DISK  1 
INSERTVOLUME(SOURCEUNIT,SOURCEVID»TRUE) ; 

END 

ELSE 

IF  (INSTRING  <>  ••)  AND  (DEFAULT  <=  0)  THEN 

WHERE  :=  DESTINATION 
ELSE 

WHERE  :=  neither; 

C  RESTORE  THE  DIRECTORY  ETC.  FOR  THE  SOURCE  VOLUME  1 
IF  WILDCARD  THEN 

SCANINPUT(FR0MWHEREiCOKDIR3tBLKOEXP»S0URcE,TRUE) 

ELSE 

SCANINPUT(FR0MWHERE»CHECK1»ERR0R1, SOURCE* TRUE) ; 
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1227 

24:o 

622 

122y 

24:n 

634 

1229 

23:  J 

0 

123U 

25:i 

0 

1231 

23  :i 

12 

1232 

23:i 

19 

1233 

25:i 

34 

123^+ 

23  ;i 

37 

1235 

23:i 

43 

1236 

23:2 

48 

1237 

23:i 

52 

1238 

23:2 

66 

1239 

23:i 

70 

1240 

23:o 

84 

i2'+l 

23:o 

96 

12f2 

23  :o 

96 

X2>*i 

23:o 

96 

1244 

23:o 

96 

12f4 

23:o 

96 

1245 

23:o 

96 

12'+6 

23:o 

96 

1247 

23:o 

96 

1248 

23  :o 

96 

1249 

23:o 

96 

1250 

23:0 

96 

1251 

23:o 

96 

1252 

23:o 

96 

1253 

28:d 

3 

1254 

28:o 

0 

1255 

28:i 

0 

1256 

28:i 

3 

1257 

28:i 

14 

1258 

28:2 

24 

1259 

28:o 

68 

1260 

28:o 

86 

1261 

28:o 

86 

1262 

28  :o 

36 

1263 

29:d 

1 

1264 

29:d 

1 

1265 

29:d 

1 

1266 

29:o 

41 

End; 

BEGIfsi    -    CHlCKFILl     ] 

INITSLOBALS; 
srcstr  :=  ••; 

PR0CrsSDATA(MSGl,TRU£,V0L!\jAMEl,STRINGl.STRING2,FR0MWHERE); 

sourceunit  :=  sunit; 
souRcEVio  :=  gvid; 

IF  DEFAULT  >  0  THEN 

EXIT(CHECKFILE) \ 
IF  (INSTRING  =  't)  AND  (DEFAULT  <  0)  THEN 

EXIT<CHECKFILE) ; 

PROCESSDATA  (MSG2,  FALSE.  V0LNAiV|E2,  STRINGS,  STRING4,T0WHERE)! 
END; 


CSI  FILER, B.TEXT3 

C*!  FILER. C.TEXT3 

C      COPYRIGHT  (C)  1979  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.  ] 

C      PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-  D 

Z  TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE  D 

C      OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS,  2 


PROCEDUREIS  FOR  MOVING,  MAKING  AND  CHANGING  FILES 3 


C  CHECKS  TO  SEE  IF  FILE  IS  ENDANGERED  BY  THE  OPERATION  TO  BE  PERFORMED  3 

FUNCTION  FINDSAME(D00  :  BOOLEAN ): BOOLEAN; 

BEGIN 

FINDSAME  :=  TRUE; 

IF  (LASTSTATE  =  OKFILE)  AND  (DOO  OR  (SOURCETlTLE  <>  GTID)  OR 

(SOURCEVID  <>  GVID))  THEN 
FINDSAME  :=  PURGElT(CONCAT(GVID,*:»,GTID).»REMOVE  OLD*) 
END; 

C  ALLOWS  THE  USER  TO  CHANGE  THE  NAME  OF  ANY  FILE  IN  THE  DIRECTORY  1 
C  OR  THE  NAME  OF  ANY  BLOCKED  DEVICE  t 

PROCEDURE  CHANGER; 
VAR 

GFiB  :  untyped; 

GFIBP  :  FIBP; 
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12o7 

12SQ 

1269 

1270 

1271 

1272 

1273 

1274 

1275 

1276 

1277 

1278 

1279 

1280 

1231 

1282 

1283 

1284 

1285 

1286 

1287 

1288 

1289 

1290 

1291 

1292 

1293 

129f 

1295 

1296 

1297 

1298 

1299 

1300 

1301 

1302 

1303 

1304 

1305 

1306 

1307 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


29; 
29; 
29; 
29; 
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29:2 

29:2 

29:2 

29:2 

29:2 

29:3 

29:4 

29:4 

29:4 

29:5 

29:4 

29:4 

29:5 

29:6 

29:6 

29:6 

29:6 

29:6 

29:7 

29:8 

29:9 

29:9 

29:9 

29:8 

29:6 

29:6 

29:5 

29:3 

29:2 

29:3 

29:3 

29:3 

29:4 

29:5 

29:5 

29:6 

29:6 


42 
4  4 
0 
G 
12 
44 
52 
72 
72 
72 
72 
78 
106 
110 
137 
140 
159 
159 
169 
173 
181 
197 
204 
208 
208 
216 
228 
236 
236 
242 
244 
246 
248 
250 
264 
264 
264 
264 
278 
263 
289 


IORSlTiLOC 


INTEGLR 


BEGIN  C  CHANGER  3 
REPEAT 

CHlCKFILE( •CHANGE', 'CHANGE  TO  WHAT », 0 , FILEBLKDEXP , TRUE i TRUE , 

COKFILE.OKDIRD) ; 
IF  ((STRINGl  <>  ")  AND  (STRINGS  <>  "))  OR  WILDCARD  THEN 

C  CHANGING  A  FILENAME  2 
BEGIN 

V0LNAME2  :=  VOLNAMEi;    C  DEST  VOLNAME  MUST  BE  THE  SAME  AS  SOURCE  3 

TOWHERE  :=  C0NCAT(V0LNAME1.':») ; 

IF  NOT  WILDCARD  THEN 

TOWHERE  :=  C0NCAT(T0WHERE«STRING3) ;   C  DEST  FILENAME  IS  IN  STRINGS  1 

Loc  :=  o; 

WHILE  SEARcHDIR('CHANGE'»LOC«TRUE,TRUE)  DO 
BEGIN 

reset(gfib,fromwhere);   c  opens  file  to  be  changed  3 

CHECKRsLT(IORESULT){ 

GFIBP  :=  GETPTR(GFIB)}    C  GETS  THE  POINTER  TO  THE  FILES  HEADER  3 
SCANINPUTC TOWHERE. CBADFILE,0KFILE3tFILEEXP, DESTINATION, TRUE); 
IF  FINDSAME(FALSE)  THEN 
WITH  GFIBP**  DO 
BEGIN 

FHEADER.DACCESS.YEAR  :=  lOOS  C  LET  THE  OP-SYSTEM  KNOW  3 
PRINTMESS{FVID.FHEADER.DTID.GTID); 

fheader.dtid  :=  gtid;      c  change  the  filename  3 

END? 
CLOSE(GFIB); 
CHECKRSLT(IORESULT) 
END 
END 
ELSE 

IF  LENGTH(STRINGX)  +  LENGTH ( STRINGS )  =  0  THEN 

C  CHANGING  A  VOLUME  NAME  3 
BEGIN 

SCANINPUTC TOWHERE tCNOVOL.OKDiR 3. BLKOEXP, DESTINATION f TRUE) ; 

IF  LASTSTATE  =  OKDIR  THEN 

MESSAGES(VOLONLINE,TRUE) ;  C  DON»T  ALLOW  TWO  VOLS  WITH  SAME  NAME  3 


1308 

i3:i 

239 

130S 

29:6 

289 

1310 

29:5 

296 

1311 

29:5 

306 

1312 

29:5 

313 

1313 

29:5 

320 

1314 

2915 

330 

1315 

29:5 

334 

1316 

29:5 

338 

1317 

29:5 

342 

1318 

29:5 

352 

1319 

29;  6 

368 

1320 

29:5 

375 

1321 

29:6 

384 

1322 

29:5 

391 

1323 

29:4 

398 

132t 

29:3 

fOO 

1325 

29:4 

402 

1326 

29  :i 

406 

1327 

29:o 

411 

1328 

29:o 

446 

1329 

29:o 

tf46 

1330 

3o:d 

1 

1331 

3o:d 

1 

1332 

3o:d 

1 

1333 

3o:d 

7 

133«+ 

3o:d 

9 

1335 

3o:o 

0 

1336 

3o:i 

0 

1337 

30:2 

0 

1338 

30:2 

26 

1339 

30:2 

29 

13'+0 

30:2 

32 

1341 

30:2 

39 

1342 

30:3 

58 

1343 

30:4 

58 

1344 

30:5 

62 

1345 

30:6 

62 

1346 

30:6 

82 

1347 

30:7 

91 

1348 

3o:a 

91 

C  ALLOCATE  ROOM  FOR  THE  DIRECTORY  &    READ  IT  IN  2 

NEW ( GDI R) ; 

U;JlTREAO(SOURCEUrJIT,GDIR'"«SlZEOF{DIRECTORY)  iDIRBLK)  J 
CHECKRSLT(IORESULT) ; 

GDIR^COD.DVID  :=  GVID;   C  CHANGE  THE  VOLUME  NAME  1 
UNITWR I Te{S0URCEUNIT,GDIR^,SI2E0F( DIRECTORY ),DIRBLK)! 

lORSLT  :=  ioresult; 

RELEASE(GDIR) ; 

CHECKRSLT(IORSLT)  ; 

UNITABLECSOURCEUNITD.UVID  :=  GVID;    L    UPDATE  THE  UNITABLE  3 

IF  (SYVID  =  SOURCEVID)  AND  ( SYSCOM'^.SYSUNIT  =  SOURCEUnIT)  THEN 

SYVID  :=  GVID;    C  NAME  OF  ROOT  DEVICE  HAS  BEEN  CHANGED  1 
IF  DKVID  =  SOURCEVID  THEN 

DKVID  :=  GVID;  C  PREFIXED  VOLUME'S  NAME  WAS  CHANGED  3 

PRINTMESS(S0URCEVID,",GVID)   C  TELL  USER  YOU  DID  THE  CHANGE        1 
END 
ELSE 

MESSAGES! ILLCHANGE. TRUE)       C  CAN»T  CHANGE  A  VOLNAME  TO  A  FILENAME  3 
UNTIL  INSTRING  =  •» 
END  CCHANGER3  ; 

C  ALLOWS  THE  USER  TO  REMOVE  ANY  SELECTED  FILE  FROM  THE  DIRECTORY  1 

PROCEDURE  REMOVER; 

VAR 

DELETIONS  :  BITMAP? 
LINE,LOC  :  INTEGER' 

BEGIN  C  REMOVER  D 
REPEAT 

CHECKFILE( 'REMOVE' , • '» 1 tFILEEXPf TRUE t TRUE. C0KFILE3) ; 

LINE  :=  O;     C  KEEPS  TRACK  OF  WHAT  LINE  OF  OUTPUT  YOUR  AT  3 

LOc  :=  o; 

FILLCHAR(DELETIONS,SIZEOF{OELETIONS).CHR(0))5  C  INIT'S  BITMAP  3 
WHILE  SEARCHDIR( 'REMOVE', LOC. FALSE, TRUE)  DO  C  GET  FILENAME  3 
BEGIN 

IF  NOT  QUESTION  THEN 
BEGIN 

PRINTMESSCGVID.GDIR'^CLOCD.DTID. 'REMOVED' )  ; 

IF  SYSCOM'^.CRTINFO. HEIGHT  =  LINE  THEN   C  DON'T  SCROLL  OUTPUT  3 
BEGIN 

NSPACEWAITCFALSE) ; 
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1345 

30:3 

9U 

1350 

30  :d 

'il 

1351 

3C:7 

il 

1352 

3c:& 

lOU 

1353 

60:b 

105 

1354 

30:4 

1:5 

1355 

io:4 

117 

1356 

30:3 

123 

1357 

30:2 

127 

1358 

30:3 

142 

1359 

30:4 

142 

1360 

30:4 

145 

1561 

30:4 

174 

1362 

30:5 

181 

1363 

30:3 

186 

1364 

3o:i 

186 

1365 

3G:0 

189 

1366 

3o:o 

212 

1367 

3o:o 

212 

1368 

3o:o 

212 

1369 

3o:o 

212 

1370 

3i:d 

1 

1371 

3i:d 

1 

1372 

3i:d 

1 

1373 

3i:d 

3 

1374 

3i:d 

3 

1375 

32:d 

1 

1376 

32:d 

1 

1377 

32:d 

1 

1378 

32  :d 

4 

1379 

32:d 

6 

1330 

32  :d 

7 

1381 

32:d 

47 

1382 

32:o 

0 

1383 

32:i 

0 

1384 

32:i 

22 

1385 

32:1 

26 

1386 

32:i 

34 

1387 

32:i 

37 

1388 

32:i 

40 

1389 

32:2 

40 

9S 


CLEAKSCKEEN; 
LTiME  :=  0 
END; 
LINE  :=  LINE+i; 
EiJD; 
DELETIONS. E.WTRltS  :=  DELETIONS. ENTRIES  +  1;  C  FILE  TO  BE  REMOVED    D 
DELETIONS, DIKENTRY  CLOC]  :=  TRUE   C  TOTAL  tt  OF  FILES  TO  BE  REMOVED  1 
END; 

IF  (FOUND  IN  CFILEF0UND,A30RTIT3)  AND  ( DELETIONS. ENTRIES  >  0)  THEN 
BEGIN 

CLEARLINE; 

WRITE(»UPDATE  DIRECTORY  ?  •);  C  MAKE  USER  CONFIRM  THE  REMOVAL  f  3 

IF  NGETCHAR{TRUE)  THEN 

ZAPENTRIES(DELETIONS,TRUE);  C  WILL  REMOVE  THE  SELECTED  FILES   3 
END! 
UNTIL  INSTRING  =  •' 

END  cRemover:  ; 

C  ALLOWS  THE  USER  TO  TRANSFER  ANY  FILE  IN  THE  DIRECTORY  TO  ANOTHER  DISK  OR  3 
C  TO  AMOTHER  FILE,  WILL  ALSO  PERFORM  COMPLETE  OR  PARTIAL  BINARY  TRANSFERS   D 

C  OF  Ome  disk  TO  ANOTHER  3 

PROCEDURE  TRANSFER; 

VAR 

LAST3LK,L0C  :  INTEGER; 

C  PERFORMS  THE  ACTUAL  TRANSFER  OF  THE  FILE  FROM  ONE  LOCATION  TO  ANOTHER  1 

PROCEDURE  movefile; 

VAR 

relblk,numblks,nblocks  :  integer; 

FiRsTCALLtSINGLEDRlVE  :  BOOLEAN; 
GFIBP  :  FIBP; 
GFIB  :  UNTYPED; 

BEGIN 

RESET(GFIB.FROMWHERE) ;  C  OPEN  SOURCE  FILE  D 
CHECKRSLT(IORESULT) ; 

GF13P  :=  GETPTR(GFIB) ;  C  GETS  A  POINTER  TO  THE  HEADER  OF  THE  SOURCE  FILE  3 

C  BLOCK  RELATIVE  TO  THE  SOURCE  FILE  D 


relblk  :=  0; 

FlRSTCALL  :=  TRUE; 
REPEAT 

NU>1BLKS  :=  LASTBLK  -  REL3LK; 


C  BLOCKS  LEFT  TO  TRANSFER  3 


15:^0 
15^1 
x3vr2 
15  35 
139'+ 
1395 
139b 
1397 
1398 
139  9 
IfOO 

l'+02 
l^+OS 
I'+Of 

l'+06 

1407 

lf08 

lf09 

I'+IO 

Itll 

lfl2 

1113 

1414 

1415 

1416 

1417 

1418 

1419 

1420 

1421 

1422 

1423 

1424 

1425 

1426 

1427 

1428 

1429 

1430 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
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5216 
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32:2 
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32:3 

32:4 

32:4 

32:4 

32:4 

32:4 

32:4 

32:4 

32:5 

32:6 
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32:7 
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32:7 

32:6 

32:6 
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32:6 

32:5 

32:4 

32:5 
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32:4 
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32:4 
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47 
52 
5b 
70 
74 
77 
77 
HO 
89 
9b 
113 
128 
128 
128 
128 
131 
136 
176 
178 
217 
220 
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220 
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236 
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242 
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253 
257 
262, 
264 
274 
278 
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278 
286 
236 
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I^  f>iJi^:BLKS  >  GdUFBLKS  THEN   C  GBUF3LKS  =  «  OF  BLKS  IN  TRANSFER  BUFFER  1 

NU.eLKS  :=  GBUFBLKS;  L    ufMBLE  TO  FIT  .HOLE  Fi[e  IN  TRANSFER  BUFFER 
r^LOi,KS    :=  3L0CKKEAD{GFI3,G3UF'^,(JUM8LKS.RELBLK)  ! 
CHLCKRSLTCIORLSULT);    C  NBLOCKS  =  #  OF  BLOCKS  ACTUALLY  READ  3 

3E3IN 

FIRSTCALL  :=  FALSE; 

SCANINPUT(TOWHERE,CNOVOL,BADOIR,BADFILE,UNBLKDVOL,OKDIR,OKFILED, 

TP  rrrwTno  ^n  . . ,  am.  ,         FILEVOLEXP, DESTINATION* TRUE ) ; 

IF  ((GVID2  <>  ♦•)  AMD  (GVID2  C13  =  '«»)  AND  (GUNIT  =  SOURCEUNIT) 

AND  UNITA3LE  CGUNITD.UISBLKD )  OR  (GUNIT  =  0)  THEN 

C  DESTINATION  DISK  IS  NOT  ON-LINE  AT  THE  MOMENT  D 

BEGIN 

CLEARSCREEN; 

IF  GUNIT  =  0  THEN 

WRITELN(»PUT  IN  •,GVID,»:') 
ELSE 

WRITELN( 'INSERT  DESTINATION  DISK') 5 
NSPACEWAIT(TRUE) ; 

C  MAKE  SURE  THAT  THE  USER  PUT  THE  VOLUME  ON-LINE  3 

SCANINPUT(T0WHEREtCBADFlLE«0KFlLEtBADDlR.0KDIR,UNBLKDV0L3. 

,„^,  FlLEVOLEXP,DESTINATIQNf TRUE) J 

END « 

IF  GUNIT  IN  Cl»23  THEN 

CLEARSCREEN;      C  DESTINATION  IS  THE  CONSOLE:  3 
IF  NOT  FINDSAME{FALSE)  THEN 

if^nblS'^'d^rblk  then  °°'''''  "'''  '°  ''"°''  '"'  ^^''■^^'^^^  "^^  ' 

,,"^'^^°'-UME;      C  make  SURE  THAT  A  DISK  ISN'T  INDANGERED  ] 
REWRITE(LFI3,T0WHERE);  C  OPEN  DESTINATION  FILE  3 
CHECKRSLT(IORESULT); 

C  GET  A  POINTER  TO  THE  HEADER  OF  THE  DESTINATION  FILE  3 
LFIBP  :=  GETPTR(LFI3)5 

IF  NOT  LFIBP'*. FISBLKD  AND  GFIBP'^.FISBLKD  AND 

<'^FIBP^,FHEADER.DFKIND  =  TEXTFILE)  THEN 
BEGIN  n  DISK  TO  CHARACTER  DEVICE  DON'T  TRANSFER  HEADING  3 

NBLOCKS  :=  nblocks-2; 
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1431 

32:6 

3G3 

1^+32 

32:5 

327 

i'+33 

32:4 

327 

1434 

32:4 

335 

1435 

32:3 

340 

143S 

32:2 

343 

1437 

32:3 

345 

143d 

32:4 

348 

1439 

32:2 

356 

1440 

32:2 

371 

1441 

32:2 

375 

1442 

32:3 

380 

1443 

32:2 

386 

1444 

32:2 

398 

1445 

32:3 

398 

1446 

32:2 

406 

1447 

32:i 

407 

1448 

32:i 

426 

1449 

32:2 

434 

1450 

32:3 

434 

1451 

32:3 

443 

1452 

32:3 

457 

1453 

32:3 

467 

1454 

32:4 

487 

1455 

32:2 

491 

1456 

32:i 

496 

1457 

32:i 

502 

1456 

32  :i 

506 

1459 

32  :i 

512 

1460 

32:i 

547 

1461 

32:o 

553 

1462 

32:o 

576 

1463 

3i:o 

0 

1464 

3i:i 

0 

1465 

31:2 

0 

1466 

3i:2 

23 

1467 

31:2 

36 

1468 

3i:2 

41 

1469 

31:2 

44 

1470 

31:3 

57 

1471 

31:4 

57 

^'0VELfc;FT(GBUF'^[;F3LKSIZE  +  F5LKSIZE3tG3UF'".NBL0CKS*F3LKSlZE) 
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end; 

SINGLEDRIVE  :=  (  LFI3P'' .  FVID  <>  GFIBP'^  .FVID )  AND 

(LFIBP'^.FUNIT  =  GFIBP'^.FUNIT) 
END 
ELSE 

IF  SINGLEDRIVE  THEN  C  ALLOW  USER  TO  INSERT  DESTINATION  DISK  2 
INSERT\/0LUME{LFI3P'*.FUNIT.LFIBP''.FVID»FALSE)  ; 
NUMBLKS  :=  BLOCKWRlTE(LFIBtGBUF'*,NBLOCKS,RELBLK)  ; 
CHECKRSLTdORESULT); 
IF  NBLOCKS  <>  NUMBLKS  THEN 

MESSAGES(FILEFULL,TRUE) ;    C  WASN'T  ABLE  TO  WRITE  OUT  ALL  THE  BLOCKS  3 
IF  SINGLEDRIVE  AND  NOT  EOF(GFIB)  THEN 
C  ALLOW  USER  TO  INSERT  SOURCE  DISK  3 
INSERT  VOLUME  (LFIBP'".FUNIT»GFIBP''.FVID,  FALSE)  ; 
RELBLK  :=  RELBLK  +  NUMBLKS    C  INCREMENT  RELATIVE  BLOCK  TO  THE  FILE  2 
UNTIL  (RELBLK  =  LASTBLK)  OR  E0F{GFIB); 
WITH  LFIBP'^.GFIBP'^.FHEADER  DO 

BEGIN  Z    MAKE  THE  HEADERS  TO  THE  TWO  FILES  THE  SAME  1 
FHEADER.DLASTBYTE  1=  DLASTBYTE} 
FHEADER.DFKIND  :=  DFKIND; 
FHEADER.DACCESS  :=  DACCESS; 

IF  (DACCESS.MONTH  =  0)  AND  (THEDATE, MONTH  >  0)  THEN 
FHEADER.DACCESS  :=  THEDATE 
END; 
CLOSE(LFI8»LOCK)5 
CHECKRSLTdORESULT); 
PRlNTMESS(GFlBP*.FVlD,GFI3P'*.FHEADER.DTIDt 

concat(lfibp'^.fvid,  •  :  •  »lfibp'^.fheader,dtid)  )  ; 
close(gfib) ; 
end; 

begin  c  transfer  2 

REPEAT 

CHECKFILE( 'TRANSFER* .'TO  WHERE* » 0«FILEVOLEXP»TRUE.TRUE. 

CBADDIR»OKFlLEtOKDlRtUNBLKDVOL3)5 
LASTBLK  :=  MAXINT;    C  WILL  BE  SET  TO  THE  U    OF  BLOCKS  TO  TRANSFER  2 

LOG  :=  o; 

IF  (STRINGl  =  ••)  AND  NOT  WILDCARD  THEN 

3EGIN      C  DISK  TO  DISK  BINARY  TRANSFER  2 
IF  LASTSTATE  IN  COKDIR t BADDIR3  THEN 


i'7o    i    lll^  ,Xi  ^^SCT3L0CKS('TRANSFER', 'BLOCKS. ,'«  OF  BLOCKS  TO  TRANSFER •, 1 , LASTBLK ) ; 

I'^^u   1   3i:5  im  £,,Q 

1477    I          -V't  I^S  "''^^'■^  SEARCHaIK(.TRAf\lSF^R',L3C, TRUE, TRUE)  DO 

*'    ■*•    -JX.H-  lo9  MOVEFILE  '«' 

^U7n    ^    !,^-^  ^^^  UNTIL  INSTRING  =  •'; 

talo    }          i^'°  ^53  END  C  TRANSFER  l; 

1^82    1    33'n  ^^?  ppnrr^^^'^^^  '^^^'^  ^^  ^^^'^"^^  ''■^'-^<S)  ON  THE  DISK  3 

1%83    1    Hlo  I  ^ar'  ^^'   MAKEFILE; 

]Hi       J   ?!:S  ^  '^''^B  :  untyped; 

IW    1    33JD  „i  GFIBP  :  FIBP; 

1H86    1    33:D  42 

tuftl  ,^    il'°  °  ^^S^N  C  MAKEFILE  1 

l'*BQ  1    33:i  0  REPEAT 

l-^Sl  1  33:3  43  BEGIN                      "^  ^^'^'^  ^^'^  '^'^  EXISTING  FILE  WITH  THIS  NAME  3 

1^93  1  IIK  5I  REWRITECGFIB.FROMWHERE);  C  OPEN  THE  FILE  2 

Usi  1  33-u  =7  CHECKRSLT(IORESULT); 

I'^^S  1  33:4  ll  SlTH%FIBl^^DJ'*r^Jrrn  m' ol^l    "    ^"'^"^'^  ^°  ^"^  «"DE«  0"^  THE  FILE  3 

I'^gfe  1  33:5  69  Jmavri  K  ?-  ?uc-AnrPS  ^°  ^^  ^"''^  ^"^  ^^^^    ^^    0^  THE  CORRECT  SIZE  3 

nil  t  ff'^  '^  CLOSE?GFIB;LO^K"?f'^-°^'^^^^^«-^"^^°"-°"«S^«^«' 

1^99  1  ?t'a  It  CHECKRSLT(IORESULT); 

isnn  ^  ^!:?  "  CLEARLINE; 

1501  i  3?;3  143  ^^WRITELN(GVID..:»,GTID,.  MADEM 

i^sn?  J  11'^  ^'^^  ^f^TlL  INSTRING  =  " 

^snf  ^  ^^'^  ^'^^  ^'^°  CMAKEFILE3  ; 

150f  i  33:o  174 

1505  1  33:o  174 

J'sr-  ^  J!*^  ^^'^  I^*^  FILER. C.TEXT3 

ilo?  1  ^^'^  ^^'^  ^"  i^iler.d.text:! 

1508  1  ^^^1  ^.l?    ^  COPYRIGHT  (C)  1979,  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNlfl  n 

1509  i  3^:  III    I  'ITAI^T    '2  'V    °'  DISTRIBUTE  THIS  SOF^JIre  OR  SoCuSeN-  ' 

1510  1  33*0  17a  r  ^^'^lON    IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE  1 
151?  1  "Ilo  17^  ^  OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS.             ] 
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1512 
151-i 
lbl4 

15lD 

1516 
1517 
151fa 
1519 
1520 
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1523 
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1525 
1526 
1527 
1528 
1529 
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1532 
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1535 
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1538 
1539 
15'+0 
1541 
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1543 
1544 
1545 
1546 
1547 
1548 
1549 
1550 
1551 
1552 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
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33 

i3 

33 

54 

34 

34 

34 

34: 

34 

34 

35 

35 

35 

35; 

35 

35; 

35; 
35; 
35; 
35; 
35; 
35; 
35; 
35; 
35; 
35; 
35; 

35 

35 

35; 

35; 

35; 

35; 

35; 

35; 

35 

35 

35 

35 

35 

35 


3 
D 
[} 
D 
D 
D 
D 
D 
0 
D 
D 
0 
D 
D 
D 
0 
1 
1 
2 
3 
3 
3 
4 
5 
6 
6 
6 
6 
6 
5 
4 
5 
6 
6 
6 
5 
2 
0 
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174 

174 

174 

5 

6 

i 

3 

3 

IS 

17 

3 

5 

12 

12 

52 

53 

53 

0 

0 

20 

,  20 

20 

61 

69 

75 

80 

80 

86 

123 

130 

133 

139 

139 

141 

141 

144 

147 

149 

151 

151 

170 


iORKFlLE.  MAIMTANENCE  PROCEIDURES 


1  L'O 
—  1 


c  allo.-js  thl  user  to  sav/e  his  wokkfile  under  any  desired  name  :i 

FUNCTlOfJ  SAVE^ORK  :  BOOLEAN; 
TYPE 

FILESTR3  =  STRING  t-43; 
VAR 

GS  :  SHORTSTRING; 

OK  :  boolean; 

FUNCTION  SAVEIT(WHATFILE  ;  FILESTRG:  WHICH  :  FILEKiND; 

VAR  TITLE  :  TID;  VAR  SAVED^GOTIT   :  BOOLEAN;  MSG  :  INTEGER)  :  BOOLEAN; 
VAR 

GFiB  :  UNTYPED; 

GFIBP  :  FIBP; 

C  CHANGES  THE  NAME  OF  THE  WORKFILE  TO  THE  NAME  DESIRED  BY  THE  USER  3 
BEGIN  C  SAVEIT  1 
SAVED  :=  TRUE; 
WITH  USERINFO  DO 
BEGIN 

RESET ( GFIB, C0NCAT(»*SYSTEM.WRK.»»WHATFILE)) ; 
GFIBP  :=  GETPTR(GFIB); 
WITH  USERINFO,  GFIBP'^.FHEADER  DO 
IF  GFIBP'^.FISOPEN  THEN 
BEGIN 

DACCESS.TEAR  :=  100; 

TITLE  :=  CONCAT(WORKTID,».«.WHATFlLE);C  CHANGE  THE  WORKFILE  NAME  1 

DTID  :=  TITLE;     C  CHANGE  THE  NAME  OF  THE  FILE  2 

SAVEIT  :=  true; 

CLOSECgFIB, NORMAL) 
END 
ELSE 
BEGIN 

SAVEIT  :=  FALSE; 

GOTiT  :=  false; 

|VIESSAGES(MSG»FALSE)   C  COULDN'T  FIND  THE  WORKFILE  ] 

END 

END  L  SAVEIT  2i 
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I5b6 
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36:2 
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I5b3 

1 

36:2 

7  3 

1559 
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34:5 

i9 

1571 
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34:5 

33 
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1 

54:6 

44 

1573 

1 
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5  0 
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1 

34:4 

56 

1575 

1 

34:3 

56 

1576 

1 

34:3 

59 

1577 

1 

34:4 

69 

1576 

1 

34:5 

69 

1579 

1 

34:5 

72 

15dC 

1 

34:b 

131 

1581 

1 

34:4 

132 

1582 

1 

34:3 

138 

1563 

1 

34:4 

142 

1561 

1 

34:4 

161 

1585 

1 

34:3 

169 

1586 

1 

34:4 

179 

1587 

1 

34:3 

135 

1538 

1 

34:4 

194 

156^ 

1 

34:5 

194 
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34:5 

202 

1591 

1 

34:5 
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34:5 

222 
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1 

34:5 
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C    CH_;Jc    IfjP.JT    iTiU^JG    TO    bE    Stli-iT    TO    THE    T(RANSFER    CO!^MAND    2 
PRCC:dJRL:    CO:iCATlT(STR     :     FILESTRG;     SAVED    :    BOOLEAN); 
bEGli 

IF    I  OT    SAVZO    FfCN 

IijSTKlrJG    :=    CONCATdlJSTRIrJG,  •  *SYSTEM,  WRK  ,  »  ,  SIR  ♦  •  ,  »  , 

G\/lD2»':'.GTlD.«.»tSTR.',' ) 

c  ,\i  Q ; 

3EG1;J  r  SAV'Ei,-JOr%K  J 
WITH  USERIf-iFO  00 
BEGIN 

SA\/E.^IORK  :=  FALSE;  C  WILL  BE  SET  TO  TRUE  IF  SAVING  TO  A  DIFFERENT  DISK  1 
uTiD  :=  i-JORKTiO; 
3VlD  :=  WORKVID; 
3\/ID2  :=  WORKVID; 

IF  TEXTSAVED  AND  CODESAVED  THEN 
3EGIN 

wPITELN; 

IF  GOTSYM  OR  GOTCODE  THEN 

messages (wrksaved. true) ; 
messages ( nowrk  t  true )  ; 
end; 

OK  :=  FALSE; 

IF  WORKTIQ  <>  ••  THEN  L    ALREADY  HAVE  A  FILENAME  T 
BEGIN 

clearline; 

i"iRITE( 'SAVE  AS  •  ♦  WORKVIO  t  •  :  •  ,  WORKTID,  •  ?  •)! 

OK  :=  NGETCHAR(FALSi) 
ENO; 
IF  NOT  OK  THEN         C  NEED  A  NEW  FILENAME  2 
CHECKFILECSAVE  AS ','•,  1 ,  FILEEXP, FALSE,  TRUE, 

lNOVOL,BADDIR,BADFILE»OKOIR,OKFILED); 

IF  LcNGTH(GTlD)  >  TIDLENG-5  THEN 

MESSAGES(ILLFILEV0L,TRUE);    C  filename  IS  TOO  LONG  2 
IF  GVID2  <>  SYVID  THEN 

^^^T-'^  C  SAVE  TO  ALTERNATE  DISK  ] 

INSTRING  :=  •♦; 

C0NCATIT(  'TEXTNTEXTSAVED)  ; 

CONCATIT{ 'CODE* , CODESAVED)  ; 

3ELETE(INSTRInG,LENSTH(INSTRING),1);    C  remove  TRAILING  COMMA  2 

savework  :=  true;    c  will  need  to  enter  T{ransfer  after  leaving  2 


C  error  nothing  TO  save  2 


c  workfile  already  saved  2 

C  NO  WORKFILE  TO  SAVE  2 
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34 
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1 

34 
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34 
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34 
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34 

:o 
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34 
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37 

0 
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1 

n 
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1 
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1 
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2 

2 
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1 
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11 
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1 
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4 

11 

1626 

1 
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1 
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4 

4  0 

1623 

1 
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5 

42 
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1 
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4 

92 
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1 

37: 

5 

98 
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1 
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5 
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1 
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1 
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3 
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1 

37: 

0 
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C  CHANGE  TITLE  OF  WORFILE  1 

C  CHAi'JGE:  VOLUME  I.D.  OF  WORFILE  1 


rxiT(  5AVt"k.UKK  ) 

;>;}!<KTID  :=  GTID; 
.\i 0 *< K  7  I D  :=  G\/Il>v 

::  L  -■  A  K  L I  !•>!  ii ; 

iF  N.iT  TCXTSaVLU  THEN 

^EjI'A  c  text  file  needs  to  be  saved  : 

IF  S'AVEIT(  'TEXT'  .  TEXTF  ILE  .  SYi^/iTID  .  TEXTSAVED  t  GOTSYR  t  TEXTLOST  )  THEN 
RE3IN 

IF  COOLSAVED  THEN  C  REMOVE  OLD  CODE  EXISTING  FILE  3 
IF  PURGFIT(C0NCAT( •*• twORKTID.'.CODE* ) ,»' )  THEN 
WRITE  COLD  CODE  REMOVED,  '); 
WRITE ('TEXT  FILE  SAVED  ') 
END; 
IF  NOT  CCDtSAVED  THEN 

WRITECS  ♦)  C  i«ILL  ALSO  NEED  TO  SAVE  NE*^  CODEFILE  1 

Ei'Ju; 

IF  NOT  CUDESAVLD  THEN  I    SAVE  CODE  FILE  1 

IF  SAVEIT{ ♦CODE'.CODEFILE,C00ETlD,C0DESAVED,G0TC0DEfCODELOST)  THEN 
.•jPITE(  'CODE  FILE  SAVED'  ) 
END 
END  CSAVEWORK]  ; 

C  InfOr:/',S  THE  USER  IF  A  WORKFILE  EXISTS  AND  IF  SO  3 
C  WHAT  fjAME  IT  IS  ASSOCIATED  WITH  3 

PROCEDURE  WHATWORK; 

BEGIN 

wriTj-andclear; 
with  usekinfo  do 

IF  gOTSYM  or  GGTCODl  THEN 

3  c.  3  I  i  j 

if  worktid  =  •'  then 
write(  'Not  named' ) 

ELSE 

wKlTE( 'WORKFILE  IS  ' , WORKVID , ' : • , WORkTID ) ; 
IF  NOT  (TlXTSAVEO  AND  CODESAVED)  THEN 

/J  R  I  TEC  (NOT  SAVED)  •  ) 

ELSE 

/JkIT£:(  'NO  WORKFILE'  ) 

END  C  w  H  f,  T  W  0  R  K  3  ; 
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C  THERE'S  A  CODE  OR  TEXT  FILE  LOADED  3 
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1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

1 

1 

i 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


i7:  J 

-"■■?.- 

38:0 

3a;i 
38:^ 

36:3 
38:3 
33:3 
38:3 
3o:3 

36:^ 
3a 

36 
36 
39 

39:a 
39:d 
39  :o 
39:i 

39:2 


39: 
39: 
39: 
39: 

39:6 
39:4 
39:5 
39:4 
39:5 

39:5 

39:5 
59:3 

39:3 

39:3 

39:3 
39:3 
39:3 
39:3 

39:5 


1 

1 

J 
) 

4 
3 

1  6 
24 
27 
32 
44 
44 
1 
2 
2 
0 
0 
12 
12 
18 
18 
21 
61 
69 
73 
73 
75 
76 
b4 
64 
34 
112 
149 
lbc3 
168 
lb3 
211 
211 


C  CllA^S  Thl  p!<LSErMT  WQRKFILE.  JSED  liJ  GETWORK  S  ME^'wQRK  3 

PKOCED  jwL  CLEA'^WO^U'  ; 

iEGl.i 

WITH  jSERIfJFO  DO 
?E3irN! 

30TSYM  :=  FALSE; 
GOTCODE  :=  FALSE; 


/iORKTID 

symtid   ; 

Ef\iJ 


:=   » f 

r   •  •  • 
* 

:=    ' » 


COOESAVED)  THEN 
WORKFILE  HASN'T 

CURRENT  WORKFILE 
THEN 


BEEN  SAVED  VERIFY  ITS  REMOVAL  D 


END; 

C  CLEARS  The  PRESENT  WORKFILE.  IF  A  SYSTEM, WRK  EXISTS  WILL  REMOVE  IT  2 

PROCEDURE  NEWWORK(GIVEBlURB:  BOOLEAN); 

VAR 

GFIB  :  FILE; 
BEGIN  C  NEWWORK  2 

WITH  USER  INFO  DO 
BEGIN 

if  not  (textsaved  and 
begin    c  current 
clearline; 
WRITE ('Throw  away 

if    not    i\IGETCHAR(  FALSE) 

exit(callproC) ; 

END 

else 
IF  giveblurb  then 

wRITELN;   C  WASN'T  CALLED  FROM  GETWORK  1 

L    REMOVE  ALL  WURKFILES  D 

IF  PURGEIT('*SYSTEM,WRK.TEXT',  ")  THEN! 

IF  PURGEIT('*SYSTEM,WRK.CODE'»")  THEN! 

IF  PUPGEIT{ •♦SYSTEM. LST. TEXT',  "  )  THEN; 

C  CHECK  FOR  A  .BACK  FILE  IN  CASE  USER  HAS  A  LARGE  FILE  EDITOR  1 
IF  PURGEIT(COIJCAT(WOF^KTIO,'. BACK'), 'REMOVE')  THEN; 

TEXTSAVED  :=  TRUE; 


101 


ib7  J 

1 

o9; 

3 

21^ 

ib77 

1 

39: 

0 

217 

i  b  7  '.i 

1 

33: 

4 

2  c:  J 

Ihli 

1 

39: 

■^ 

2  ?  0 

Ib&G 

1 

39: 

u 

22  0 

loSi 

1 

39; 

o 

223 

i&B2 

1 

09: 

6 

«i4'^ 

1663 

1 

39: 

5 

251 

LbaH 

1 

1 

39: 

2 

2M 

1685 

1 

39: 

0 

2b  1 

1666 

1 

39: 

0 

27r) 

1637 

1 

39: 

0 

273 

i63d 

1 

^o: 

;j 

1 

J. 

1689 

1 

40: 

D 

1 

1690 

1 

i+o; 

D 

1 

1691 

1 

40: 

0 

1 

1692 

1 

i+o; 

D 

1 

1693 

1 

40 

,D 

3 

169^+ 

1 

40 

■D 

4 

1695 

1 

40 

:d 

4 

1696 

1 

41 

;d 

3 

1697 

1 

41 

:o 

0 

1698 

1 

41 

:i 

J 

1699 

1 

41 

12 

10 

1700 

1 

41 

.3 

13 

1701 

1 

41 

;3 

13 

1702 

1 

41 

:3 

65 

1703 

1 

41 

;4 

70 

17U4 

1 

41 

:5 

70 

1705 

1 

41 

:5 

73 

1706 

1 

41 

:5 

77 

1707 

1 

41 

:5 

102 

170d 

1 

41 

:b 

103 

1709 

1 

41 

:6 

113 

1710 

1 

41 

:5 

125 

1711 

1 

41 

:4 

134 

1712 

1 

41 

:2 

134 

1713 

1 

41 

:g 

134 

171'+ 

i 

41 

:o 

146 

1715 

1 

40 

:o 

0 

1716 

1 

4  0 

;i 

0 

IE-    51VE3LJR5    THEri 

A'lTH    uS::R:i;FO    ~0       C     r-JFORM    THE    USER    OF    THE    STATUS    OF    THE    WORKFILE    1 

clla.^li'JL; 

WRITE(  •^0RKF1LE  CLEA.^ED'); 
CLEARwOi^K; 

END 
E'C 
END  C  ^jrWwX'RK  D; 

C  ALLOWS  THE  USER  TO  LOAD  A  NEW  FILE  NAME  irgTO  HIS  WORKFILE  3 

PROCEDURE  GETWQRK; 

TYPE 

SHORT  =  string: 3 j; 

VAR 

DOME, OK  :  boolean; 
X  :  integer; 

:  CHECKS  to  see  whlther  or  mot  the  requested  FILE  to  be  loaded  exists  3 
function  checkit(SUffix,mess:short;  var  title:tid;  var  volid:vid)  :  boolean; 

3EGl,'\i 

with  userinfo  00 

BEGIN 

CHtCKIT  :=  FALSE;  ,„,.^. 

SCANINPUT(CONCAT(WORKVlDi«:«tWORKTID,SUFFlX),COKFILED»0» neither .TRUE), 

IF  LASTSTATE  =  OKFILE  THEN 

BEGIN       C  THE  REQUESTED  FILE  HAS  BEEN  FOUND  D 
CHECKIT  :=  TRUE; 

DONE  :=  true; 

TITLE  :=  CUNCAT(W0RKTID, SUFFIX) ; 

VOLID  :=  workvid; 

IF    GOTSYfv-i    THEN 
WRITE(«A    •); 
.■JRITl(MESS) 

END 
END 

end; 


3EGlrj  C  3ETW0RK  1 
NEWWOrK( FALSE) ; 


C  ClCaR  EXISTING  WORKFILE  3 


1717 

1716 

1719 

172  J 

1721 

J.722 

172i 

1724 

1725 

1726 

1727 

1723 

1729 

1730 

1731 

1732 

1733 

173(+ 

1735 

1736 

1737 

1738 

1739 

1710 

1741 

1742 

1743 

1744 

1745 

1746 

1747 

1748 

1746 

1749 

1750 

1751 

1752 

1753 

1754 

1755 

1756 


1 
1 
1 
1 

1 

i 

1 

i 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


4j:i 
40  ;i 

4  0:2 
40:3 

4i):3 

4u:3 

40:3 
4C:3 
40:3 
40:3 
40:4 
4C:4 
40:5 
4Q:6 
40:4 
40:5 
40:6 

4o:& 

40:5 

4o:4 

40:3 
40:3 

io:4 

40:5 

10:5 
4o:4 
4o:3 
4o:2 
io:o 


40 
40: 
40: 
40; 

401 

4o; 
40; 
40; 
40; 
4o: 
40: 
40: 


26 
2b 
2.b 
26 
55 
42 
49 
56 
b9 
59 
63 
70 
121 
131 
151 
151 
180 
202 
209 
209 
215 
225 
225 
227 
240 
240 
261 
261 
276 
276 
276 
276 
276 
276 
276 
276 
276 
276 
276 
276 


CHCCKFILEC  '  GET ',  t  t  ,  i ,  piL^^^xP  ,  FALSE  »  TRUE  ,  C  3A0FILE  ,  0KFILE3  )  ; 
lillH    USER  INFO  JO 

dEGl:>J 

CLEAR'^ORK;   C  cLEARWORK  HASfg'T  CLEARED  UORKFILE  YET  IN  CASE 
WO^KVIu  :=  G\/IDi 


OF  NUL  INPUT  2 


I    CAN  A  '.TEXT'  OR  '.CODE'  SUFFIX  BE  ADDED  1 


OR 
OR 


».CODE«  SUFFIX  MAY  ALREADY  EXIST  3 
<C0PY{W0RKTIDtX-4t5)=»,C0DE»)  THEN 
♦.TEXT'  OR  '.CODE'  SUFFIX  1 
(WORKTID  <>  ♦•)  THEN 
3 

.SYMTID«SYMVID) ; 

♦♦CODETID»CODEVID) 


WO^rKTIG  :=  GTio; 
X  :=  Llngth(worktid) ; 
OK   :=  X  <=  tidle:ng-5; 
cleaRLine; 

REPEAT 

DONE  :=  NOT  ok; 

IF  DONE  AND  (X  >  o)  THEN  C  ».TEXT' 
IF  (COPY( WORKTID* X-4. 5) =•. TEXT') 
DELETE(W0RKTID»X  -  4,5);  C  REMOVE 
IF  UENGTH(WORKTIO)  <=  TlDLENG-5)  AND 
BlGIN  I    SEE  IF  FILE  IS  IN  DIRECTORY 
GOTSYM  :=  CHECKIT( '.TEXTS 'TEXT  » 
GOTCOOE  :=  CHECKlT('.CODE»f 'CODE 
ENO; 
OK  :=  FALSE 
UNTIL  DONE; 
IF  NOT  (GOTSYM  OR 
BEGIN   C  WASN'T 
CLEARWORK; 
WRITECNO  ») 
END; 
WRITE( 'FILE  LOADED') 
END 
END  CGETW0RK3  : 


CSI  FILER, D.TEXT3 

C$1  FILER. E.TEXT3 

C      COPYRIGHT  (C)  1979,  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA. 

C      PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN- 

C      TATION  IN  HARD  OK  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE 

C      OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS. 


GOTCODE)  THEN 
ABLE  TO  FIND  THE 


FILE  3 


3 
3 
3 
3 


I DIRECTORY  RELATED  ROUTINES  -• 

C  ALLOWS  THE  USER  TO  SET  THE  DATE  IN  THE  DIRECTORY  3 


105 


1757 

i75a 

1755 

17^0 

1761 

17o2 

1763 

176^ 

1765 

1766 

1767 

1768 

1769 

177Q 

1771 

1772 

X773 

1771 

1775 

1776 

1777 

1778 

1779 

1780 

1781 

1782 

1783 

178J+ 

1785 

1786 

1787 

1788 

1789 

1790 

1791 

1792 

1793 

179^ 

1795 

1796 

1797 


1 
1 
1 

1 

■4. 

i 
1 
1 
1 

■1 
M 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

i 

1 

1 


■+2:j 
'+2:d 
f2:j 
'+2::j 
42  :o 
t2:D 
"+3:0 
^^3:0 

43:1 
■+3:0 


43 
43 
43 
44 

44:d 

44:D 

44:o 
44:i 
44:i 
44:i 

44:2 
44:3 

44:i 
44:o 
44:o 
42:o 
42:i 

42:2 
42:3 
42:3 
42:4 
42:3 
42:3 
42:3 
42:3 
42:4 
42:3 
42:3 
42:4 


i 

1 

i. 

1 
1 

^1 

d- 

1 

0 

0 

21 

29 

42 

42 

42 

3 

4 

4 

0 

0 

4 

20 

31 

45 

68 

78 

96 

0 

0 

0 

0 

53 

63 

158 

179 

197 

202 

209 

216 

218 

227 


PRJCcDiJi^E  iJATESET; 
COInIST 

DASH  =  '-• ; 

NUfJ!  :  inteGv^r; 


On 


:  ONLY  uELIM.viITER  ALLOWED  TO  SEPARATE  FIELDS  IN  THE  DATE  3 


C  DELETES  INPUT  STRING  UP  TO  THE  NEXT  FIELD  DELIMITTER  1 

PROCEDURE  ZAPIT; 

3EGIN 

DEleTE(INSTRING»1»SCAN(LEMGTH{INSTRIMG) ♦=dash.instringci])) ; 

QELETEdNSTRINGtltl) 

End; 

c  translates  number  in  character  representalqn  into  integer  representation  1 
i   and  checks  to  see  if  it  is  in  the  allowable  range  d 

function  getnumber(max  :  integer)  .*  boolean; 

VAR 

XfSTOP  :  INTEGER? 
BEGIN 

NUNi  :=  o; 

STOP    :=    SCAN(LENGTH(INSTRING) i=DASHiINSTRlNGCl3); 
FOR    X    :=    1    TO    STOP    DO 

IF    INSTRINGCX3    IN    DIGITS    THEN 

NUM    :=    NUM*10+ORD{INSTRINGCX:)-ORD(»OM5 

getnumber  :=  (num  >  o)  and  (Num  <=  max) 

END? 

BEGIN  CDATESETJ 
WITH  THEDATE  DO 
BEGIN 

WRITELN( 'DATE  SET:  <1. . 31>-<JAN. .DEC>-<00. .99>» ) « 

IF  MONTH  <>  0  THEN  C  WRITE  OUT  PRESENT  DATE  IF  IT  IS  VALID  3 

WRITELN( *TODAY  IS  • ,DAYiDASH«COPr ( M0NTHSTR,M0NTH*3+1 .3) ,DASH» YEAR ) 5 
WRITE( 'NEW  DATE  ?  •) 5 
READLNdNSTRiNG)  ; 
EATSPACES(INSTRING) 5 
IF  GETNUMBER{31)  THEN 

DAY  :=  NUM;    E  A  NEW  DAY  WAS  FOUND  3 
ZAPIT;   C  delete  INPUT  STRING  UP  TO  THE  NEXT  DELIMMITER  3 
IF  INSTRINGCOJ  >  CHR(2)  THEN 
BEGIN 


1793 

42:o 

227 

1799 

42:b 

2o2 

IBOO 

H^:t: 

242 

1301 

^+2:^ 

253 

1802 

42:7 

268 

18U3 

42:5 

2i37 

180^ 

42:6 

298 

180  5 

42:7 

32C 

ISOo 

42:4 

325 

1807 

42:3 

334 

1808 

42:3 

336 

1309 

42:4 

343 

1810 

42:3 

350 

1811 

42:3 

383 

1812 

42:4 

395 

1813 

42:5 

395 

1814 

42:5 

406 

1815 

42:4 

411 

1616 

42:3 

411 

1817 

42:2 

503 

1818 

42:0 

503 

1819 

H2:o 

520 

1820 

^+2:0 

520 

1821 

45:d 

1 

1822 

45:d 

2 

1823 

'^5:0 

2 

182<+ 

45:d 

4 

1825 

45:o 

305 

1826 

'^5:d 

312 

1827 

'+5:d 

312 

1823 

'+6:d 

1 

1829 

46:0 

0 

1830 

'+6:1 

0 

1831 

46:2 

19 

1832 

46:3 

19 

1333 

46:3 

22 

1334 

46:3 

25 

1835 

46:4 

36 

1836 

46:3 

39 

1837 

46:4 

51 

1838 

46:3 

54 

Gvio  C3:  :=  CHR(3) ; 

hOVELEFr( INSTRINGC1],GVIDC1],3) ; 
FOR  i\lUM  :=  2  TO  3  DO 

IF  (GVID  CNUM3  >=  'AM  AND  (GVIO  CNUM]  <=  »ZM  THEN 

GVIO  LNU,Jlj  :=  CHR(  ORD(GVID  CNUMD)  -  ORO('A')  +  0RD{»A»))5 
FOR  NUM  :=  1  TO  12  DO 
IF  C0PY(M0NTHSTR,NUM*3+i,3)  =  GVID  THEN 

'-10NTH  :=  NUM     C  A  NEW  VALID  MONTH  HAS  BEEN  GIVEN  2 

end; 

ZAPIT;   C  DELETE  INPUT  STRING  UP  TO  THE  NEXT  DELIMMITER  3 
IF  GETNUMBER(99)  THEN 

YEAR  :=  NUM;   C  A  VALID  YEAR  HAS  BEEN  GIVEN  2 
SCANINPUT(CONCAT{SYVID.»:' ), COKDIR 3, 0» NEITHER ,TRUE ) ; 
IF  (LASTSTATE  =  OKDIR)  AND  (GUNIT  =  SYSCOM'^.SYSUNIT)  THEN 

BEGIN  C  THE  ROOT  VOLU-viE  IS  ON-LINE,  WRITE  THE  DATE  OUT  TO  ITS  DIR.  3 
3DIR'*C03.DLASTBOOT  :=  THEDATE; 
WRITE0IR(GUNIT,GDIR) ; 
END; 

WRITE(»THE  DATE  IS  ' 'DAYfDASH, COPY (M0NTHSTR,M0NTH*3+1 ,3) t DASH* YEAR) 

END 
END  C  DATESET  3  ; 

C  ALLOWS  THE  USER  TO  SEE  WHAT  &    WHERE  HIS/HER  FILES  ARE  IN  THE  DIRECTORY  1 

PROCEDURE  LISTDIR(DETAIL:  BOOLEAN); 

VAR 

NOFlLEStALTFILE  :  BOOLEAN; 

OUT  :  TEXT; 

LISTED* LOG, LINE, LARGEST, FREE3LKS.USEDAREA,USEDBLKS:  INTEGER; 

n  KEEPS  TRACK  OF  WHAT  LINE  OF  OUTPUT  WE'RE  AT  SO  WE  DON»T  SCROLL  LISTSING  3 

PROCEDURE  writeline; 

BEGIN 

IF  (LINE  =  SYSCOM'^.CRTINFO, HEIGHT)  OR  (LINE  =  0)  THEN 

BEGIN    C  WRITE  OUT  VOLUME  NAME  AT  TOP  OF  EACH  PAGE  OF  OUTPUT  3 
HOMECURSOR; 
CLEARLINE; 
IF  NOT  ((LINE  =  0)  OR  QUESTION)  THEN 

NSPACEWAIT(FALSE);   C  LET  USER  LOOK  AT  WHATS  ON  THE  SCREEN  3 
IF  (NOT  UNITABLECDESTUNIT3.UISBLKD)  OR  QUESTION  THEN 

CLEARSCREEN;         C  LISTING  TO  CONSOLE  3 
WRITELN{OUT) 5 


J07 


L6iS 

1 

46 

:3 

■oi) 

1340 

I 

4b 

:5 

11 

13H1 

1 

4b 

•  * 

b2 

ld42 

i 

4o 

:4 

a  7 

iS43 

1 

46 

:2 

'?a 

laiH 

1 

46 

:i 

36 

1845 

1 

46 

:i 

lb2 

1846 

1 

46 

:q 

106 

1347 

1 

46 

:g 

124 

1843 

1 

46 

:o 

124 

1849 

1 

47 

:d 

1 

1850 

1 

47 

:o 

3 

1851 

1 

47 

:d 

3 

1852 

1 

47 

:d 

4 

1653 

1 

47 

:o 

0 

1854 

1 

47 

:i 

0 

1855 

1 

47 

:i 

5 

1856 

1 

47 

12 

13 

1857 

1 

47 

;i 

18 

1858 

1 

47 

:i 

23 

1859 

1 

47 

12 

37 

1860 

1 

47 

:3 

37 

1861 

1 

47! 

,3 

75 

1862 

1 

47; 

4 

78 

1863 

1 

47; 

3 

86 

1864 

1 

47; 

4 

88 

1865 

1 

47; 

3 

96 

1866 

1 

47: 

2 

96 

1867 

1 

47: 

0 

98 

1868 

1 

47: 

0 

110 

1869 

1 

45: 

0 

0 

1870 

1 

45: 

1 

0 

1871 

1 

45: 

1 

47 

1872 

1 

45: 

1 

57 

1873 

1 

45: 

2 

60 

1874 

1 

45: 

3 

60 

1875 

1 

45: 

3 

72 

1376 

1 

45: 

3 

76 

1877 

1 

45: 

2 

90 

1873 

1 

45: 

1 

92 

1879 

1 

45: 

2 

54 

.Vr(lTE{OdT,SOURCi:;VrJ,  • :  •  )  5 

uli-Jt.  :=  2; 

iF  ALTFILt  THEM 

LINE  :=  sYScoM'^.CRTirjFO. height;  c  list  the  heading  only  once  2 

Z  \  J  5 
wRlTELi'i(OUT)  ; 

Li'JE   :=  LirjE+1 

END  CWRITELINED  ; 

C  WRITES  OUT  UNUSED  AREAS  DM  THE  DISK  3 
PROCEDURE  FREECHECK(FIRST0PEN,NEXTUSED:  INTEGER); 
VAR 

freearea:  integek; 

BEGIN 

FReEAREA  :=  NExTUSED-FIRSTOPEN;  C  finds  space  between  last  &    NEXT  FILE  1 
if  freearea  >  LARGEST  THEN 

LARGEST  :=  FREtAREA;  C  IS  THIS  THE  BIGGEST  SPACE  ON  THE  DISK  1 

FREE3LKS  1=  FREEBLKS+FREEAREA ;   C  RUNNING  TOTAL  OF  FREE  BLOCKS  1 
IF  (FREEAREA  >  0)  AND  DETAIL  THEN  C  EXTENDED  LISTING  3 
3EGIN 

WRITE(OUT,»<  UNUSED  >•, FREEAREA; 10 .••: 10 ) ; 
IF  FAST  THEN 

WRITE ( OUT* FIRST0PEN:6) 
ELSE 

write(OutiFIRstopen:5) ; 

writeline 

END 
END  CFREECHECKD  ; 

BEGIN  CLISTDIRU 

CHECKFILE( 'DIR  LISTING  OF ♦,»♦, -1 , FILEBLKDEXP» TRUE i FALSE tCOKDlRtOKFlLED ) ; 
ALTFiLE  :=  TOWHERE  <>  ";    C  ARE  WE  LISTING  TO  CONSOLE:  OR  NOT  ?  1 
IF  ALTFILE  THEN 
BEGIN 

SCANINPUT( TOWHERE, CBAOFILEfOKFILEfUNBLKDVOL 3, FiLEUNBLKDEXPf DESTINATION 

iTRUE) ; 
SCANINPUT(FR0MWHERE,C0KDIR,0KFILE3,FILEBLKDEXPiS0URCE»TRUE) 
END 
ELSE 

TO«vHERE  :=  '#2:';  C  we  are  LISTING  TO  THE  CONSOLE:  3 


ISdO 

1 

4b:i 

105 

ld3i 

1 

'+5:1 

113 

i332 

^5:i 

119 

1833 

^5:i 

123 

133^ 

'+5:1 

127 

1085 

45:1 

131 

laas 

45:i 

135 

1887 

45  :i 

139 

1380 

45:i 

143 

1889 

45:i 

151 

1890 

"+5:2 

161 

1891 

'+5:3 

161 

1892 

"tsis 

174 

1893 

'+5:2 

177 

1894 

'+5:1 

177 

1895 

"+5:2 

180 

1896 

'+5:1 

180 

1897 

'+5:2 

184 

1898 

«+5:i 

194 

1899 

•+5:2 

198 

1900 

45:3 

216 

1901 

'+5:4 

216 

1902 

1+5:4 

228 

1903 

•+5:4 

228 

190H 

45:5 

228 

1905 

^+5:6 

235 

1906 

'+5:7 

235 

1907 

45:7 

237 

1908 

45:6 

254 

1909 

'+5:5 

254 

1910 

'+5:6 

256 

1911 

'+5:4 

264 

1912 

'+5:5 

266 

1913 

'+5:4 

269 

1914 

'+5:4 

277 

1915 

'+5:5 

286 

1916 

•+5:6 

286 

1917 

'+5:6 

301 

1918 

'+5:6 

313 

1919 

'+5:6 

323 

1920 

'+5:6 

372 

rewr-ite(out,towhef?t.)  ; 
checkrsltdohesult)  ; 
liste:-.  :=  o; 
Loc  :=  0; 

LINE  :=  0; 
LARGEST  :=  o; 
FREE3LKS  :=  0; 

usedarea  :=  o; 


:  CHANGE  OUTPUT  TO  APPROPRIATE  DEVICE 
L     TOTAL  U    OF  FILES  LISTED 


C  OUTPUT  LINE  U    TO  AVOID  SCROLLING  Op  LISTING  1 

C  LARGEST  FREE  AREA  ON  THE  DISK  3 

C  TOTAL  n    OF  FREE  BLOCKS  ON  THE  DISK  2 

L  SIZE  OF  FILE  LISTED  2 


USED3LKS  :=  GDIR-C0D.DLAST8LK;   C  TOTAL  »    OF  BLOCKS  BEING  USED 
IF  STRINGI  =  »•  THEN 

BEGIN   C  IN  CASE  OF  EMPTY  DIR  THE  U    OF  UNUSED  BLOCKS  WILL  BE  DISPLAYED  1 
N0FIl.ES  :=  NOT  WILDCARD  AND  (GDIR'^  C  0  3.DNUMFILES  =  0); 
WILDCARD  :=  TRUE; 
END; 
IF  WILDCARD  THEN 

WRITELINE    C  CORRECTION  FOR  GOOD  LOOKING  OUTPUT  2 
ELSE 

If''noT  N0FILES°?hEn'^^^'^''°'^^^'^"^*^'  ^    ^^^^^^   ^^^^   ^^'^'    °°^*^  "'^"^  HEADING  2 

WHILE  SEARCHDIR( 'LIST' «LOC, FALSE. FALSE)  DO  C  GET  FILE  TO  BE  LISTED  2 

BEGIN 

IF  UNITABLECDESTUNIT3,UISBLKD  AND  (NOT  QUESTION)  THEN 

C  WRITING  DIRECTORY  OUT  TO  A  BLOCKED  DEVICE  3 
IF  LISTED  =  0  THEN  C  FIRST  CALL  TO  PROCEDURE  3 

BEGIN 

WRITEANDCLEAR; 
WRITE{ 'WRITING') 
END 
ELSE 

WRITEC.'  ) 
ELSE 

CLEARLINE; 
LISTED  :=  LISTED  +  i; 
WITH  GDIR'^CLOCD  DO 
BEGIN 

freecheck(Gdir'^i:loc-i:,dlastblk,dfirstblk);c  check  for  free  blocks  3 

USEDAREA  :=  DLASTBLK-DFIRSTBLK ;  C  AREA  USED  3 

USEDBLKS  :=  USEDBLKS+USEDAREA;   C  RUNNING  TOTAL  OF  USED  BLOCKS  3 
WRITEC OUT tDTlD.":TlOLENG-LENGTH(DTlD)+l,USEDAREA:4fDACCESS.DAY:3 
.'-»,C0PY(M0NTHSTR,DACCESS.M0NTH*3+1,3),'-',DACCESS,YEARI2)5 
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r^2i 

1 

4t5 

4.i5 

i5»22 

45 

:7 

■4  o  d 

1925 

1 

4  5 

16 

441 

1921+ 

1 

45 

IS 

4  71 

1925 

1 

4  5 

17 

515 

192q 

1 

45 

'.6 

517 

1927 

i_ 

45 

:& 

565 

1928 

1 

45 

:5 

565 

i929 

1 

45 

5o7 

1930 

1 

4b 

:i 

5b:J 

1931 

1 

45 

:2 

578 

1932 

1 

45 

:3 

573 

1933 

1 

45 

:4- 

531 

193*+ 

1 

45 

:5 

561 

1935 

1 

45 

:5 

595 

193& 

1 

45 

;5 

638 

1937 

1 

45 

'.G 

641 

1938 

1 

45 

:5 

697 

1939 

i 

45 

:5 

773 

1940 

1 

4b 

;6 

776 

1941 

1 

4b 

;4 

7B1 

igi+z 

1 

45 

,3 

7t5l 

1913 

1 

45 

:3 

785 

19H4 

1 

45 

;3 

791 

19^+5 

1 

45: 

2 

795 

ig^fG 

1 

4b, 

0 

795 

1947 

1 

45; 

0 

324 

1948 

1 

45: 

0 

324 

1949 

1 

4S; 

D 

1 

1950 

1 

43; 

Q 

0 

1951 

1 

43: 

1 

1 

1952 

1 

48: 

1 

6 

1953 

1 

43; 

1 

35 

1954 

1 

48; 

1 

47 

1955 

1 

43; 

2 

58 

195a 

1 

48; 

3 

66 

1957 

i 

48; 

4 

74 

1953 

1 

48: 

5 

74 

1959 

■1. 

48; 

5 

52 

1960 

1 

48; 

6 

86 

1961 

1 
J. 

48: 

5 

99 

If    DTITAIL  THEW  C  EXTENDED  LISTING  1 

IF  FAST  THEr; 

a'RITE(0UT,0FIRST3LK:6,DLAST3YTE:5»  "  :2« 

C3PY(TYP£STRiORD(DFKINQ)*4+l,4) , •FILE* ) 

ELSE 

WRirr(0UT,DFlRST3LK:5i •  • , COPY ( TyPlSTR » ORD ( DFKINO ) *4+l , 4 

.'JKITELINl 
END 

ENt; 

IF  (POUND  IN  CFIlEF0UND,A30RTIT3)  OR  NOFILES  THEN 
S  E  o  X  N 

IF  WILDCARD  THt-N 
'5EGIN 

FREECHECK{GDIR''CLOC3.0LASTBLK,GDIR*:OD,DEOVBLK)  ; 
WRITE(OUT,LlSTEDf  •/♦»3DIR'^C0  3,DNUMFILESt»  FILES'  )  ; 
IF  FAST  THEN 

,'JRITE{OUTt '<LlSTED/lN-DIR>t  '.USEDBLKSt'  BLOCKS  USEDM; 
WRITE(OUT,»,  SFREESLKS,'  UNUSED*t».  »»LARGEST,»  IN  LARGEST')! 
IF  ALTFILE  THEN 
^RITELN(OUT) 

end; 

CHECKRSLT(IORESULT) ; 

clOSE(qut.lock) ; 
checkrslt(Ioresult) ; 

EN -J 
END  CLISTDIRD  ; 

C  LISTS  THE  VOLUMES  THAT  ARE  ON-LINE  2 

PROCEDURE  LISTVOLS; 

BEGIN 

hJRITuuN; 

writeln( 'VOLS  on-line:' ); 

SJNiT  :=  VOLSEARCH(GVlD,TRUE,GDIR) ;  C  UPDATE  UNITABLE  D 
FOR  GUNIT  :=  1  TO  MAXUNIT  DO 
WITH  UNITABLECGUNITD  DO 
IF  IJVID  <>  "  THEN  C  VOLUME  IS  ON-LINE  2 
iiEGIN 

write(gunit:3) ; 
if  uisblkd  then 
writec  #  ')  c  blocked  device  1 

ELSE 
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) ) 


1962 

1 

'isrb 

101 

l-3bi 

i 

■4«:5 

111 

1964 

1 

46:4 

133 

19o5 

1 

4  a:  1 

IHJ 

x966 

1 

48:i 

1  J8 

1967 

1 

43:0 

236 

1963 

1 

43:0 

250 

1969 

1 

'■^Bid 

250 

1970 

^+9:0 

i 

1971 

49:0 

1 

1972 

49:j 

1 

1973 

^+9:^ 

14 

1974 

49:0 

0 

1975 

49:1 

0 

1976 

'+9:1 

7 

1977 

49:1 

10 

1978 

H9:i 

39 

1979 

1^9:1 

41 

1980 

49:1 

67 

1981 

'+9:2 

74 

1982 

1+9:1 

77 

1983 

t+gii 

134 

igat* 

49:1 

139 

1985 

^+9:2 

139 

1986 

'+9:2 

164 

1987 

^+9:2 

182 

1988 

49:2 

187 

1989 

49:, 5 

209 

1990 

49:2 

242 

1991 

49:2 

256 

1992 

'+9:1 

287 

1993 

"+9:1 

294 

1994 

49:2 

294 

1995 

49:3 

294 

1996 

49:3 

300 

1997 

49:3 

306 

1993 

49:3 

313 

1999 

49:3 

319 

2000 

49:3 

328 

2001 

'+9:3 

332 

2002 

"+9:2 

359 

.'iRITE{  '  •  :i.)  ;     :    U^ijLDCKCD    DEVICE.'    ] 

wkiTrLf.;(UviDi  • :  • ) 

WRIT,:lN( 'ROOT  VOL  IS  -  '^SYVID,':');    C  BOOTED  VOLUME  : 
WRlTiaNCPRLTIX  xS    -  •.DKVID,';')     Z    PREFIXED  VOLUME  2 

C  CriEATES  AN  E^IPTY  DIRECTORY  ON  A  DISK  : 

PROCEDURE  ZEROVOLJmE; 

VAR 

lde:  direntry; 


BEGIN  C  ZEROVOLUME  J 

FlLLCHAR(LDEiSlZEOF(LDE) ,CH 
L0E.DLAST3LK  :=  DlRLASTBLKJ 
CHECKFILECZERO  DiR  OF*,", 
RiSKVOLUiME;      C  DOES  THE 
WRITE( 'DUPLICATE  DIR  ?  •); 
IF  NSETCHAR(TRUE)  THEN 

LDE.DLASTBLK  :=  DUPOIRLASTBLK ; 
GETSLOCKSCARE  THERE*, 'BLKS  OH    THE 

REPEAT 

WRITE(«NEW  VOL  NAME  ?  •); 
REaDLN(INSTRING) ! 
EAtsPACES(INSTRING) ; 
IF  (INSTRING  CLENGTH(INST'?ING)3 

instring  :=  concatcinstring 
scar\|input(  instring,  cnovol 
wRitecgvid,*:  correct  ?  •); 

UNTIL  MGETCHARCTRUE) ; 

WITH  lOE  do 

B£GI^J 

DFkiND  :=  UNTYPEDFILE;   C 

DVio  :=  gvid;         l 

DLASTBOOT  :=  THEDATE;    C 
INSERT VOLUME (SOUKCEUN I T,S 
UNITWRITE(S0URCEUNIT,LDE, 
CHECKRSLT(IORESULT)  ; 
vi/RlTe(OVIO,*:  ZEROED*) 
END 


R(0) ) ; 

C  LEAVE  ROOM  FOR  DIRECTORY  AND  BOOTSTRAP 
1, BLKDEXP, FALSE, FALSE, C0KDIR,BADDIR3); 
DISK  ALREADY  HAVE  A  DIRECTORY  ON  IT  ?  3 

C  DOES  THE  USER  WANT  A  BACKUP  DIRECTORY  ? 


DISK»,*«  OF  BLOCKS  ON  THE  DISK' 
LDE.DLASTBLK, LDE, DEOVBLK) ; 


t  • 


0 

•): 


»  ?  f 


)  AND  (INSTRING  <>  *• )  THEN 


.OKOIR 3, BLKDEXP, NEITHER, TRUE) 


DIRECTORIES  MUST  BE  OF  THIS  TYPE 

ENTERS  NAME  OF  DIRECTORY 

USED  TO  SET  THE  SYSTEM  DATE  UPON  BOOTING 
3URCEVID,TRUE);    C  DON'T  KILL  THE  WRONG  DISK 
SIZEOF(LDE),DIRBLK); 
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2003  1  49 :0  5'j^         LNil    CZ-.<OV  JLUMED    ;  ^^ 

2004  1  49;f)  374 

2005  i  49:0  i74  l FILE:  M  AI  MTANENCE  PROCEDURES 2 

5  00a  1  49: J  374 

^0^17  1  4,9:0  374         C     Ii>JFO^viS    THE    USEr^    OF    FILES    EMDATiGERED    3Y    BAD    BLOCKS    D 

2008  i  50:0  1  PRvJCEDjRE    PRIfviTFI^FS ; 

2009  1  50 :D  1  VAR 

2010  1  50 :o     i     I  :  integer; 

2011  1  50:C      0    BEGIN 

2012  1  50:i      0      IF  DIRMAP, ENTRIES  >  0  THEN 

2013  1  50:2      9        BEGIN     C  THERE  ARE  FILES  ENDANGERED  BY  BAD  BLOCKS  1 

2014  1  50:3      9  ^RITELN( 'FILECS)  ENDANGERED :M 5 

2015  1  50:3  44  FOR  I  :=  0  TO  MAXDIR  DO 

2016  1  50:4  55  IF  DIRMAP.DIKENTRY  CI3  THEN 

2017  1  50:5  64  WITH  GDIR-^  CID  00 

2018  1  50:6  70  BEGIN 

2019  1  50:7  70  IF  I  =  0  THEN 

2020  1  50:8  75  WRITE ( 'DIRECTORY ♦ i •• t 7 )  C  THERE'S  A  BAD  BLK  IN  THE  DIRECTORY  2 

2021  1  50:7  104  ELSE 

2022  1  50:a  106  WRlTE(DTIDt":i6-LENGTH(DTlD)) ;    C  WRITE  OUT  THE  FILES  NAME  1 

2023  1  50:7  132  WRITELN {DFIRSTBLK:6 ,DLASTBLK:6 ) 

2024  1  50:5  156  END 

2025  1  50 : 2  156        END 

2026  1  50:o  163    END; 

2027  1  50:0  180 

2028  1  50:0  180    C  DETERMINES  WHAT  FILE  A  BLOCK  IS  IN  OR  BETWEEN  3 

2029  1  51:D      1    PROCEDURE  WHICHFILE ( VAR  BADBLK : INTEGER ;  MARK  I    BOOLEAN); 

2030  1  5i:0      3    VAR 

2031  1  5l:o      3      X  :  I-^gTEGER; 

2032  1  5l:0      0  BEGIN 

2033  1  5i:i      0      IF  GOIR  <>  NIL  Th£N 

2034  1  51:2      5        3E3IN 

2035  1  5i:3      5  FOR  X  :=  0  TO  GDIR^  C 0 3.DNUMFILES  DO 

2036  1  5i:4  21  IF  GDIR"  C X D.DLASTBLK  >  BADBLK  THEN 

2037  1  3l:5  31  BEGIN  C  THE  BLOCK  MUST  BE  IN  THIS  FILE  IF  ANY  AT  ALL  1 

2038  1  51:6  31  IF  NOT  MARK  THEN 

2039  1  51:7  35  BADBLK  :=  X    C  FOR  K(RUNCH  THIS  IS  ALL  WE  WANT  TO  KNOW    3 

2040  1  5i:6  36  ELSE 

2041  1  51:7  40  IF  GDiR"  C X D. DFIRSTBLK  <=  BADBLK  THEN 

2042  1  51:8  50  BEGIN        C  THE  SLOCK  IS  IN  THIS  FILE  MARK  IT  <S  SUCH  2 

2043  1  51:9  5D  DIKMAP .ENTRIES  ;=  DIRMAP. ENTRIES  +  1; 


^94't 

1 

0113 

'o2 

20^5 

X 

31  :£ 

bi 

^3^6 

51:6 

7C 

2047 

51:5 

74 

-iu'+e 

5i:i 

31 

20'+5 

51:4 

85 

2050 

5i:2 

92 

2051 

5i:o 

95 

2052 

5i:o 

110 

2053 

51  :o 

110 

205t+ 

52:o 

1 

2055 

52:d 

1 

2056 

52:d 

1 

2057 

52  :d 

257 

2058 

52:d 

260 

2059 

52:o 

0 

2060 

52;i 

0 

2061 

52:i 

35 

2062 

52  :i 

88 

2063 

52:i 

92 

2061+ 

52:2 

113 

2065 

52:3 

113 

2066 

52:3 

126 

2067 

52:4 

132 

2068 

52:5 

132 

2069 

52:5 

140 

2070 

52:5 

146 

2071 

52:4 

195 

2072 

52:2 

195 

2073 

52:i 

205 

2074 

52:i 

242 

2075 

52:o 

242 

2076 

52  :o 

258 

2077 

52:o 

258 

2078 

52  :o 

258 

2079 

52:o 

258 

2030 

53:d 

1 

2081 

53:o 

1 

2032 

53:d 

1 

2083 

53:d 

2 

2081 

53:d 

2 

DIKMAP.0IRE'\JTRY    CXD    :=    TRUE 

END  i 
EXir(  A'HICHFILE) 

END; 

IF  NOT  MARK  THEN 

BADBLK  :=  GDIR-  C 0  J. DNUMFILES  +  1     C  WELL  NEED  THIS  FOR  K(RUNCH  D 

Ei'JO 
ENj; 

C  SCANS  THE  BLOCKS  ON  A  DISK  FOR  READ  ERRORS  3 

PROCEDURE  BADBLOCKS; 

VAR 

A  :  ABLOCK; 

BLKiTOTALt  NBLOCKS  :  INTEGER; 

BEGIN  C  BADBLOCKS  ] 

CHECKFILECBAD  BLOCK  SCAN  OF* ♦•», 1 ,BLKDEXP,FALSE. FALSE, C0KDIR,BADDIRD) ; 
GETBuOCKS(»SCAN  FOR S »BLOCKS' , 'SCAN  FOR  HOW  MANY  BLOCKS* , 1 ,NBL0CKS) • 
I OT"L  • ~  0  5 

FOR  3LK  :=  0  TO  NBLOCKS-1  DO 
BEGIN 

UNlTREAD(GUNlT»A,FBLKSIZEfBLK) ; 
IF  lORESULT  <>  0  THEN 

^^^'^^         ^  C  AN  ERROR  WAS  FOUND  IN  READING  THE  BLOCK    3 

WHICHFILECBLK^TRUE);   C  WAS  THE  BAD  BLOCK  IN  A  FILE  7  l 

WRITELNC iBLOCK  ».BLK,»  IS  BAD') 

END 
END; 

SoJlr!:?'/!?^*'-''  ^^^    BLOCKS');  C  PRINT  OUT  THE  FILES  WITH  BAD  BLKS  IN  THEM  3 

r^KllMTF-lLES 

END  cbadblocksd  ; 

C  COMPARES  SUCCESSIVE  READS  &    WRITES  FOR  EQUALITY,  IF  THEY  ARE  EQUIVELENT  1 

r    S^^'-'^^n^  ^"*^  ^^^  ^^°^^    ^S  °-'<-  OTHERWISE  DECLARES  THE  BLOCK  AS  BEING    3 
C  BAD  AND  ALLOWS  THE  USER  TO  MARK  THE  AFFECTED  BLOCKS  AS  SUCH  T 

PROCEDURE  XBLOCKS; 
VAR 

NEwDiR  :  '^integer; 

BAD  :  ARRAY  C 0. .HALFMAXDIR3  OF  RECORD 
FIRST, LAST  :  INTEGER 
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2035 

1 

53:[j 

v 

?0S6 

1 

53: -J 

32 

iua? 

1 

63:3 

rt7 

2038 

1 

b5:!j 

100 

2085 

1 

-J  o «  u 

612 

2090 

1 

53:0 

D 

20  91 

1 

53:i 

0 

20^2 

1 

53:i 

35 

2093 

1 

63  :i 

33 

2094 

1 

53:i 

62 

2095 

1 

53:i 

70 

2096 

1 

53:2 

50 

2097 

1 

53:i 

so 

2098 

1 

53:2 

Sb 

2099 

1 

53:3 

86 

2100 

1 

53:3 

94 

2101 

1 

53:4 

105 

2102 

1 

53:3 

111 

2103 

1 

53:2 

114 

2101 

1 

53:i 

115 

2105 

1 

53:2 

121 

2106 

1 

53:3 

131 

2107 

1 

53:i 

140 

2108 

1 

53:2 

152 

2109 

1 

53:i 

156 

2110 

1 

53:i 

159 

2111 

1 

53:i 

165 

2112 

1 

53:2 

182 

2113 

1 

53:i 

195 

211f 

1 

53:2 

204 

2115 

1 

53:3 

204 

2116 

1 

53:3 

206 

2117 

1 

53:3 

227 

2113 

1 

53:4 

235 

2119 

1 

53:2 

239 

2120 

1 

53:i 

239 

2121 

1 

53:i 

243 

2122 

1 

53:i 

255 

2123 

1 

53:i 

258 

2124 

1 

53:i 

262 

3LK.LASriL0CKiL0CtFlRSTBLKiLAST3LK 

ld'l.   :   diklntry; 
AiS  :  ablock; 


1  JL 


INTEGER; 


,  ".IfSLKDEXPiFALSEtFALSE.COKDIR.BADDlRa); 


BEGIN  r  X3L3CKS  ] 

CHECKFILE( 'EXA'^irjE  BLOCKS  OM' 

CLEA^LH^it; 

WRITEC  •3L0CK-RAigGE    ?    •); 

READ(FIRSTBLK) ; 

IF  EolN  them 

LAST3LK  :=  FIRSTBLK 
ELSE 

BEGIN 

READ(LAST3LK) ; 

if  not  eoln  then 

writeln; 
lastblk  :=  abs(lastblk) 

END; 
IF  GDIR  <>  NIL  THEN 

IF  LASTBLK  >=  GDIR'*  C03.DEOVBLK  THEN 

LASTBLK  :=  GOIR'^  C  0  D.DEOVBLK-1 ;   C  DON'T  WANT  TO  SEEK  PAST  END  OF  DISK  1 
IF  (FIRSTBLK  <  0)  OR  (FIRST3LK  >  LASTBLK)  THEN 

exitcxblocks) ;  c  invalid  block  range  3 

clearscreenj 

WRITELN; 

FOR  3LK  :=  FIRSTBLK  TO  LASTBLK  DO 


2125 


53:2 


279 


WHicHFILE(BLK,TRUE) ; 
IF  DIRMAP. ENTRIES  >  0  THEN 
BEGIN 

PRINTFILES; 
WRITE( 'FIX  THEM  ?  ♦ ) i 
IF  NOT  NGETCHAR(TRUE)  THEN 
EXIT(CALLPROC) 
END; 
FlLLCHAR(BADfSlZEOF(BAD) tO) ; 

FILLCHAR(DIRMAP,SI^EOF(DIRMAP),0) ; 
LOC  :=  0; 

LAST3L0CK  :=  -10; 

FOR  3LK  :=  FIRSTBLK  TO  LAST3LK  DO 
BEGIN 


C  DETERMINE  WHAT  FILES  ARE  IN  THE  BLOCK-RANGE  2 


C  PRINT  WHAT  FILES  ARE  INDANGERED  2 


212b 

33: 3 

27  3 

2127 

53:3 

3U4 

212d 

53:3 

317 

2129 

53:3 

33  0 

21 3  Q 

53:^ 

536 

21-51 

53:3 

343 

2132 

53:^ 

364 

2133 

53:3 

39  0 

213(+ 

53:4 

392 

2135 

53:5 

392 

2136 

53:5 

415 

2137 

53:5 

420 

2138 

53:6 

425 

2139 

53:7 

435 

2140 

53:8 

435 

21^+1 

53:9 

444 

sita 

53:0 

444 

2143 

53:o 

460 

2l*f^ 

53:o 

466 

21f5 

53:i 

485 

2146 

53  :o 

438 

2147 

53:9 

496 

2148 

53:8 

499 

2149 

53:8 

508 

2150 

53:7 

508 

2151 

53:4 

512 

2152 

53:2 

512 

2153 

53:i 

520 

2154 

53:2 

530 

2155 

53:i 

534 

2156 

53:i 

536 

2157 

53:i 

564 

2158 

53:2 

573 

2159 

53:i 

609 

2160 

53:i 

626 

2161 

53:2 

634 

2162 

53:i 

638 

2163 

53:i 

643 

2164 

53:2 

643 

2165 

53:3 

643 

2166 

53:3 

649 

.'JRITE( 'BLOCK  'tBLiO; 
J-!lTRt:AD(GUMlT.A,FBLKSlZ£,6LK)  ; 
Ji'j I  r  i,R  I TE  (  G  J(j  I  T  ,  A  ,  F3LK S I ZE  ,  BLK  )  J 
IF  IQRESULT  =  0  THEN 

UNITREAD(GUNlT,BtFBLKSIZEtBLK) ; 
IF  (lORESULT  =  0)  AND  (A  =  B)  THEN 

i«IRITELN(  •  ,WAY  BE  OK  •  ) 
ELSE 
BEGIN 

WRITELN( »  IS  BAD* ) ; 

wHICHFILE(BLK,TRUE);    C  IS  THE  SAD  BLOCK  IN  A  FILE  7  3 

IF  GDIR  <>  NIL  THEN 

IF  BLK  >  GDIR'^  C03.DLASTBLK  THEN 

BEGIN   C  CALCULATE  THE  #  OF  BAD.XXXX.BAD  FILES  &    WHERE  THEY  GO  3 
IF  LASTBLOCK+l  <>  BLK  THEN 
BEGIN 

BAD  C03. FIRST  :=  BAD  C03. FIRST  +  1; 

LOC  :=  LOC  +  i; 

IF  LOC  >  (MAXDIR+DIRMAP.ENTRIES-GDIR'^  C03.DNUMFILES)  THEN 

CHECKRSLT{0RD{IN0R00M))5  C  NO  ROOM  TO  ADD  BAD.XXXX.BAD  1 
BAD  CL0C3. FIRST  :=  BLK 
END  I 

BAD  CL0C3,LAST  :=  BLK; 
LASTBLOCK  :=  3LK 
END 
END 

END! 

IF  Bad  C03. first  =  o  then 

EXITCXBLOCKS) ! 
PRINTFILES?   C  WRITE  OUT  FILES  THAT  WILL  BE  REMOVED  IF  DIRECTORY  IS  MARKED  3 
WRITE('MARK  BAD  BLOCKS   ?•); 
IF  DIRMAP. ENTRIES  >  0  THEN 

WRITEC  (FILES  WILL  BE  RE^^OVED  !)•); 
WRITE('  (Y/N)  •); 
IF  NOT  NGETCHAR(TRUE)  THEN 

EXIT(CALLPROC); 
ZAPEiMTRIESCDIRMAP. FALSE)  ; 
WITH  lOE  DO 

BEGIN 

DFKIND  :=  XDSKFILE? 

dlastbyte  :=  FBLKSIZE; 


C  REWOVE  FILES  WITH  BAD  BLOCKS  INSIDE  OF  THEM  3 


2167 

b5:3 

654 

216b 

53:3 

661 

2169 

53:? 

663 

2170 

53:i 

631 

il71 

53:2 

701 

2172 

53:3 

710 

2173 

53:4 

710 

217*+ 

53:4 

716 

2175 

53:4 

724 

2176 

53:5 

739 

2177 

53:6 

739 

2178 

53:6 

761 

2179 

53:5 

777 

2180 

53:4 

788 

2181 

53:4 

796 

2182 

53:5 

807 

2183 

53:4 

815 

216(f 

53:3 

825 

2185 

53:i 

833 

2186 

53:i 

835 

2187 

53  :o 

862 

2188 

53:o 

383 

2189 

53:o 

888 

2190 

53:q 

888 

2191 

54:D 

1 

2192 

54  :d 

1 

2193 

54:d 

1 

219^ 

54:d 

1 

2195 

54:0 

1 

2196 

54:d 

1 

2197 

54:d 

7 

2198 

54:d 

8 

2199 

54:d 

8 

2200 

55:d 

1 

2201 

55:D 

4 

2202 

55:d 

5 

2203 

55:d 

5 

2204 

56:d 

1 

220  5 

56:o 

16 

2206 

56:d 

16 

2207 

56:d 

20 

daccess  :=  theuate; 
otid  :=  'bad.xxxxx.bad' 

ENQ: 
FOR    MK    :=    1    TO    BAD    COJ. FIRST    DO 
WITH    LuE.BADCBLKJ    00 
JEGIfxi 

OFIPSTBLK  :=  FIRST! 
DLASTBLK  :=  LAST+1! 
FOR    lOC    :=    4    DQifllNTO    0    DO 

begin   c  makes  the  starting  block  «  part  of  the  file  name  3 
dtidc9-l0c3  :=  chr(first  div  ip0tcl0c3  +  ord(»0m); 
first  :=  first  mod  ipotclocd 
end; 
loc  :=  gdir^coj.dnumfiles; 
while  dfirstblk  <  gdir'*cl0c3. dlastblk  do 

LOC  :=  LOC  -  i; 
insentry(lde»l0c+1»gdir)i   c  add  the  bad.xxxx.bad  file  3 
end; 

UPDATEDIR;      C  WRITE  OUT  THE  NEW  DIRECTORY  1 
WRITEC'BAD  blocks  MARKED') 
END  CXBL0CKS3  ; 

C  ALLOWS  THE  USER  TO  OPEN  UP  THE  LARGEST  FREE  SPACE  AVAILABLE  ON  THE  1 
C  DISK  AT  ANY  DESIRED  LOCATION  3 

PROCEDURE  KRUNCH; 
TYPE 

WAY  =  (FOURWARDfREVERSE);    C  DIRECTION  FILES  ARE  BEING  MOVED  3 
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VAR 


GINX, SPLIT fFIRSTBLK,NBLOCKS,RELBLOCK,CHUNKSlZE 
reboot:  BOOLEAN; 


integer; 


C  DOES  THE  CALCULATIONS  FOR  MOVING  THE  FILES  3 

PROCEDURE  KRUNCHITCDIRECTION  :  way;  VAR  STARTING, OTHER  :  INTEGER; 

STOPPING  :  INTEGER); 

C  DOES  THE  ACTUAL  MOVING  OF  THE  FILES  FROM  ONE  LOCATION  TO  THE  NEXT  3 

PROCEDURE  MOVElTdNOUT  :  SHORTSTRING;  SLOCK  :  INTEGER); 

VAR 

3LK,X, START, STOP  :  INTEGER; 


2203 

1 

beiD 

u 

2209 

1 

36: 1 

-^ 

2210 

1 

n6:  1 

10 

2211 

1 

56:1 

18 

2212 

1 

56:2 

1.  ..J 

2213 

X 

56:3 

P.5 

2214 

1 

56:3 

23 

2215 

1 

56:2 

2  9 

2216 

1 

56;i 

55 

2217 

1 

56:i 

33 

221a 

i 

56:2 

46 

2219 

1 

56:3 

66 

2220 

i 

56:4 

66 

2221 

1 

56:5 

79 

2222 

1 

56:4 

92 

2223 

1 

56:5 

94 

2224 

1 

56:4 

107 

2225 

1 

56:5 

113 

2226 

1 

56:6 

113 

2227 

1 

56:6 

180 

2223 

1 

56:5 

184 

2229 

1 

56:4 

184 

2230 

1 

56:3 

186 

2231 

1 

56:o 

192 

2232 

1 

56:o 

216 

2233 

1 

55:o 

0 

2234 

1 

55:i 

0 

2235 

1 

55:2 

8 

2236 

1 

55:3 

18 

2237 

1 

55:4 

15 

2233 

1 

55:4 

35 

2239 

1 

55:5 

40 

2240 

1 

55:4 

57 

2241 

1 

■L 

55:5 

59 

2242 

1 

65:4 

73 

2243 

1 

55:4 

97 

2244 

1 

55:5 

12C 

2245 

1 

55:4 

130 

2246 

1 

55:4 

138 

2247 

1 

55:4 

142 

2248 

1 

55:5 

142 

START  :=  RELyLOCK;   l  RELATIVE  BLOCK  OF  THE  FILE  TO  START  MOVING  FROM  3 

STOP  :=  STAin+CHJNKSI?E;  L    LAST  REL.  BLOCK  IN  THE  FILE  TO  BE  MOVED  2 
IF  DIRECTION  =  REVERSE  THEN 

°^^If'''       C  MUST  NEGATE  LOGIC  PARAMS  GIVEN  ARE  NEGATIVE  &    REVERSED  2 

START  :=  -stop; 

STOP  :=  -RELBLOCK 

END! 

X  :=  0; 

rtlTH  GDIR'^CGINX3  DO 

FOR  8LK  :=  block+start  TO  block+stop-1  do 

^EIGIN         C  00  CONSECUTIVE  READS  OR  WRITES  2 
IF  INOUT  =  'READ*  THEN 

UNlTREAD(GUNlTi3eUF'^CXDtF8LKSIZE,BLK) 
ELSE 

UNITWRlTE(GUNlT»GBUF^CXD,F3LKSlZEtBLK); 
IF  lORESULT  <>  0  THEN 

BEGIN     C  TELL  USER  WHERE  IN  THE  FILE  AN  ERROR  OCCURRED  1 
WRITEdNOUT,'  ERROR,  REL  SBLK-BLOCK ,  •  .  ABS  'tBLK): 
EXIT(KRUNCH) 
END; 
X  :=  X+FBLKSIZE 
END 
ENQ; 

BEGIN 

WITH  GCIR'^CGINXD  DO 

IF  DFKIND  <>  XDSKFILE  THEN 
BEGIN 

WRITE( 'MOVING  •)! 

IF  DIRECTION  =  FOURWARQ  THEN 

WRITE(*F0RWARDM 
ELSE 

WRITE( 'BACK') ; 


WRITELN( 
IF  DTID 

REBOOT 
NBLOCKS 
RELBLOCK 
REPEAT 

CHUNKSIZE 


♦DTID); 
=  'SYSTEM. PASCAL'  THEN 

:=  GviD  =  syvid; 
:=  dlastblk-dfirstblk; 

:=  0; 


:=  NBLOCKS 


C  IS  THIS  BEING  DONE  ON  ROOT  DISK 

C  NUMBER  OF  BLOCKS  IN  THE  FILE 

C  RELATIVE  BLOCK  TO  THE  FILES 

Z  U    OF    BLOCKS  LEFT  TO  MOVE 


2 
2 
2 
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2249 

i 

OtJ.'O 

143 

.2250 

i 

t'Olo 

155 

2251 

1 

55:5 

lb? 

2252 

1 

55:5 

16  9 

2253 

1 

^35:5 

130 

2254 

1 

55:5 

lyi 

2255 

i 

55:^+ 

2[Ji 

2256 

1 

55:4 

206 

2257 

1 

55:5 

213 

2256 

1 

55:4 

220 

2259 

1 

55:5 

224 

2260 

1 

55:4 

233 

2261 

1 

55:4 

236 

2262 

1 

55:3 

236 

2263 

1 

55  :o 

238 

22&f 

1 

55:0 

254 

2265 

1 

54  :o 

0 

2266 

1 

54  :i 

0 

2257 

1 

54:i 

24 

2268 

1 

54:i 

75 

2269 

1 

54:i 

84 

2270 

1 

54:i 

39 

2271 

1 

54:i 

92 

2272 

1 

54:i 

101 

2273 

1 

54:i 

104 

227'+ 

1 

54:i 

110 

2275 

1 

54:2 

123 

2276 

1 

54:3 

129 

2277 

1 

54:4 

141 

2273 

1 

54:i 

162 

2279 

1 

54:i 

169 

2280 

1 

54:2 

185 

2231 

1 

54:3 

191 

2282 

1 

54:4 

191 

2283 

1 

54:5 

197 

2284 

1 

54:4 

205 

2285 

1 

54:3 

205 

22B6 

1 

54:i 

216 

2287 

1 

54:i 

251 

2288 

1 

54:2 

254 

2289 

1 

54:3 

254 

IF    CrlU."JK':-:TZC    >    GBUF3LKS    THEtj 

CHUi\IKSl2L     :r    GGUF3LKS;  C 

iKJLOCKS    ;=    rjBLOCKS    -    CHUNKSIZE;C 
lOVEIK  '.^EAD'  ,STARTIi\!G)  ;  C 

-iCVEIK  '/vKlTE'  »ST0P°ING)  ;  C 

r(£L5LUCK     :=    RELDLOCK  +  CHUfJKSiZE ! 
UNTIL    N3L0CKS    =    0; 
IF    DIRECTION    =    REVERSE    THEN 

OTHER    :=    STOPPING    -    (DLASTBLK    - 
ELSE 

OTHER    :=    STOPPING    +    (DLASTBLK    - 

STARTING  :=  stopping; 

UPDATEOIR 

£N0 
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THE  BUFFER  ISN'T  BIG  ENOUGH 
BLOCKS  LEFT  TO  MOVE 
START  READING  THE  FILE 
WRITE  IT  OUT  SOMEWHERE  ELSE 


1 
1 
1 


DFIRSTBLK) 
DFIRSTBLK) ; 


NEW  DFIRSTtJLK  : 
NEW  DLASTBLK  1 


END 


BEGIN  C  KRUNCH  1 

CHECKFILE(  •  CRUNCH  •  »",  1 .  BLKDEXP ,  FALSE ,  FALSE  t  COKDIR  3)  ; 
GETBLOCKS( 'FROM  END  OF  DISK,  BLOCK» ♦♦♦ f » STARTING  AT  BLOCK  «». 

GDIR'^  COD. DLASTBLK, SPLIT); 
WHICHFILECSPLIT, FALSE) ;     C  WHICH  FILES  GO  WHICH  DIRECTION  ?  1 
REBOOT  :=  FALSE;  C  WILL  BE  SET  TO  TRUE  IF  *SYSTEM. PASCAL  IS  MOVED  1 
SYSCOM'.MISCINFO.NOBREAK  :=  TRUE;  C  IGNORE  ALL  BREAK  CHARS.  DURING  KRUNCH  3 
CLEARSCREEN; 
WRITELN; 
FOR  GINX  :=  1  TO  SPLIT-1  DO 

WITH  GDIR'^  CGINX3  DO      C  MOVE  THESE  FILES  TOWARDS  THE  FIRST  BLOCK  3 
IF  DFIRSTBLK  >  GDIR''  CGINX-1 3. DLASTBLK  THEN 

KRUNCHIT(F0URWARD,  DFIRSTBLK,  DLASTBLK,  GDIR'*  CGINX-1  D.  DLASTBLK  )  ; 
FIRST3LK  :=  GDIR^CO:,DEOVBLK; 
FOR  SINX  :=  GDIR^COn.DNUMFlLES  DOWNTO  SPLIT  DO 

WITH  GDIR'^  CGINXJ  DO      C  MOVE  THESE  FILES  TOWARDS  THE  LAST  BLOCK  1 
BEGIN 

IF  DLASTBLK  <  FIRSTBLK  THEN 

KRUNCHIT (RE VERSE, DLASTBLK, DF I RSTBLK,FIRSTBLK) ; 
FIRSTBLK  :=  DFIRSTBLK 

end; 
writeln(gvid, • :  crunched'); 
if  reboot  then 

BEGIN  C  *SYSTEM, PASCAL  WAS  MOVED  2 
WRITELN( 'PLEASE  RE-BOOT'); 


ii-^l  1    54:2    234         EKn; 

22I3    1    bJir    III         ^„^YSCD/-.,^ISCr>IFO.r.OBREAK  :=  FALSE 


3m 


2294  1  51+:^, 

2295  1  54:0 
229fe  1  54 :o 
2297  1  54:d    314 


2295    1    54:0    314  - __ 

229^    1    54:0    314  ^      "■■ ^^l\l^^    ROUTINE 


-|e  ?:;S  l\l  [    lf,l   T'^Tf,^^\ll,'^l^l,ll)\"^'^    «-^"^-  "  IS  INVOKED  I.  .«  :«pi«T.  3 

ixil  }  2:D  1  PROCEDURE  CALLPROC;           "                                              ^ 

2300  1  2:0  1  VAR 

nil  \  2:j  1  x,Y  ;  integer; 

nil  ]  2:d  3  OK  :  300LEAN; 

2i03  1  2:D  4 

lllX  \  cs^iS  ?  ■■  ^^^^^    OP-SYSTEM  PROMPT  ROUTINE  1 

IMl  \  l]f,  I  PROCEDURE  PROMPTEM(STR  :  STRING); 

llrX  1  57:1  12  PROMPT; 

2310  1^  VrW  \l  CH  :=  GETCHAR(NOT  OK); 

2311  i  s'lo  27  EnS-  •''  '"^  ''  '*  •'•?»''B....EN.GN.K....N»,.p....T..»V...X.,.Z»a 

2312  1  57:0  60 

2313  1  2:0  0  BEGIN 

l\\l  ]  2:1  0  initglobals; 

tl]l  ]  2:1  2  INSTRING  :=  •»; 

i\^,^  ]  ?•!  10  OK  :=  true; 

2317  1  211  13  REPEAT 

IWl  J  2:2  13  IF  FAST  THEN 

2320  1  V^  ^^  PROMPTEMC 

2321  1  2:2  97  """""ksE"'  "'"""'  ''""''  ''"''  '*°'"'  ''^'"'  '^"'^^^  "^"^^^S,  D(ATE,  Q(UIT  CIIDM 

2323  \  VA  \l\  iF^cnT'^rTHEN'-'  "  ''  '*  ''  ''  ''  ''  ^'  ^  "^^*" 

""" IF  FAST  THEN 

PR0MPTEM( 


2324  1     2:3    148 

2325  1     2:4    151 


2327    \  2:3    232  ""■''*  ^^^^^'^^^^^^  E(XT-DIR.  K(RNCH,  M(AKE,  P{REFIX,  V(OLS,  X(AMINE,  Z(ER0  CIIDM 

2329  i     2';i    2?6      UNTIL  ^^^^^^  ^ '^^^^«  ^  «'  B.  E,  K,  M,  P.  v,  X,  Z  dlDM 

2330  1     2:1    281      HOMECURSOR; 
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"!  Q 


n 


2351 

23J3 
233<4 
2335 
2336 
2337 
233b 
2333 
2340 
23'+l 
23^+2 
2343 
2344 
2345 
2346 
2347 
2348 
2349 
2350 
2351 
2352 
2353 
2354 
2355 
2356 
2357 
2353 
2359 
2360 
23S1 
2362 
2363 


1 
1 

1 

J. 

i 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


2: 1 


2 
2 

2: 
2; 
2; 
2: 
2: 
2 ; 
2; 
2; 
2; 
2; 
2: 
2: 
2: 
2; 
2; 
2; 
2; 
2: 

21 
21 

2; 

2; 
2; 
2: 
2: 
2: 
2: 
2: 
2; 
2; 
2; 
2; 
2; 
2; 
2; 
2: 
2 


>;w^4 
?67 
30  o 
3  r;  ^ 
320 
32ii 
336 
349 
360 
3bO 
362 
444 
444 
460 
463 
468 
473 
477 
482 
486 
490 
494 
504 
504 
531 
538 
545 
543 
586 
583 
592 
596 
600 
604 
608 
612 
616 
620 
624 
684 
710 


CLEA 
IF  C 

CL 
FOk 
WITH 


^  m 

X  :  = 

ui^ii 
oVi 

IF 


CASE 
•L 
I  r 

•G 
•N 
•C 
•R 
•T 
•S 
'P 


CH 


f  l;v' 

•M 
•V 
'B 
•Z 

•X 

»K 

•D 
»Q 

END 
ENO; 


C  1 

C  •  »  ,  • 

CREt^j; 

1  TC  1 
TABLLlX 

J  <>  •• 
r  :=  x+ 

UVID  = 
SEGIN 
WRITE 
WRITE 

WRITE 

end; 

OF 

LISTOIR 
lISTDIR 
3ETW0KK; 
^JEWWORKCTRUE)  ; 
CHANGER; 
REMOVER; 
TRANSFER; 

IF    SAVEWORK    THEN    TRANSFER; 
3LGIN 
CHECK 


8'.'D','Q','\/'.'Z'D    THEN 

1    LJO 
J    DO 

THEN 
1    TO    1?    DO 

UNITABLECYD.UVID    THEiJ 

Ai\iDCLEAR; 

(•WARNING    UNITS    '.X.'    &    '.Yi'    HAVE    THE    SAME    NAMEMJ 

AijDCLEAR 


(FALSE) ; 
( TRUE) ; 


FILECPREFIX    TITLES    BY*  t  "  1 1  ♦  VOLEXP»FALSE» 

FALSEtCN0V0L»BADDIR,0KDIR«UNBLKDV0L3) ; 

:=  GVID; 

LINE; 

(•PREFIX    IS    ♦.OKVIDt':') 


OKVID 
CLEAR 
WRITE 

einId; 
whatwork; 

^JIAKEFILE; 
LiSTVOLSi 

badblocks; 
zerovolume; 

XBLOCKS; 

krjnch; 

OATESET; 
EXIT(FILEHANDLER) 


MAIN  SLG'^'i^NT  ROUTINE 


^372  1     2:g  710  : -._ 

■^;5  73  1  ^:Q  Tin  ^' 

^^^'^  1     i:0  0  3EGIN  CFlLEHAr^DLERa 

^^'l^  1  i:i  0  WITH  uscRrgpo  .^o 

f^^^  J  }'^  12  3F.3l;j       C  Ii^lTlALIZE  WORKFILES  1 

^iy  I  ^j3  12  TEXT3AVED  :=  .JOT  GUTSYM  OR  (GOTSYM  AND  (SYMTID  <>  •  SYSTEM.  WRK.  TEXT  •))  ; 

237^  I  III  -^^  ^^  CODCSAv/ED  :=  NOT  GOTCOOE  OR  (GOTCODE  AND  (CQOETID  <>  »SYSTEM.  WRK.  CODE' )  ) 

23I1  i  i:}  i'i  ^Jf3  :=  (SYSCOM-.CrTINFO. width  >=  80)  AND  (NOT  SYSCOM- .MISCINFO.SLQWTERM)  ; 

it^^  ^  1-1  -^9  MARK(G3UF);   C  SET  UP  TRANSFER  BUFFER  1 

2382  1  1:1  105  GBUF8LKS  :=  C; 

^333  1  1:1  los  REPEAT 

238^  1  1:2  106  NEWOlOCKPTR); 

2335  1  1:2  113  GBUF3LKS  :=  GBUFBLKS+15 

2386  1  1:2  113 

iltl  ]  Ji?  H^  ^    ^^^"^^    ^^^"^    ^^^    ^I^^^  VARIABLES  TO  KEEP  FROM  STACK  OVERFLOWING  3 

lias  1  iM  IxT  *J'^TIL  {(MEiVlAVAIL  >  0)  AND  (ME^^AVAIL  <  (  SIZEOF  (  DIRECTORY) +SIZEQF(  FIB) +102f  ))  ) 

till  I  ;:t  11^  OF?  (63UFBLKS  =  63);  C  BLOCK  I/O  LIMITATION  D 

nil  ?  ^*^  ^'^^  ^    ABBREVIATIONS  FOR  THE  MONTHS  S  FILE  TYPES  D 

tilt  t  J:^  Ji^  MONTHSTR  :=  ' ???janfebmaraprmayjunjulaugsepoctnovdec?????????» ; 

2394  1  iM  typestr  :=  »    BAD  codetextinfodatagraffoto* ; 

mi  }  }'l  ^^^  repeat  C  call  DRIVING  ROUTINE  IN  AN  INFINITE  LOOP  3 

tilt  ^  ^'^  ^^^  CALLPROC; 

2397  1  1:2  2tfl 

lilt  }  Wl  l"^]  ^,  If^  CASE  WE  ABORTED  FROM  TRANSFER  AND  LEFT  A  TEMP  FILE  3 

till  J  .:l  ^^^  ^^    UNITABLEC0ESTUNIT3,UISBLK0  THEN 

2'*;?  1  1:3  250  CL0SE(LFIB, PURGE) 

2'+01  1  1:2  256  ELSE 

IVil  1  1:3  253  CLOSE(LFIB) 

2403  1  1:1  264  UNTIL  FALS^^ 

2404  1  1:0  264  end; 

2405  1  1:0  290 

2'+06  0  1:0  0  BEGIN 

2'+07  0  1:0  0  END. 
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1 

■5 
4 
5 

6 
7 

a 

9 
10 

11 

12 
13 

m 

15 
16 
16 
17 
18 
19 
20 
21 
22 
23 

2^ 

25 
26 
27 
2b 
29 
30 
31 
32 
33 
3*+ 
35 
36 
37 
38 
39 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

i:d 

i:d 

i:d 

i:d 

i:o 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 
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*) 
*) 
*) 
*) 
*) 
♦  ) 

*) 
*) 


******************^^^*^^^^^^,^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^Jj 


*SI  HEAD  *) 
*SU-*) 
1  CONST 

1^    Vrn\-l^,^    "  "^^   **  ^^^^^^    OF  CHARACTERS  IN  A  VOLUME  ID  ♦) 
1    TIOLENG  =  15;  (*  NUMBER  OF  CHARACTERS  IN  A  TITLE  ID  ♦) 

1  TYPE 
1 

DATEREc=PACKED  RECORD 

month:  o,.12; 

day:  0..31} 

year:  0..100 

end; 


VID  =  STRINGCVIDLENG3; 
TID  =  STRlNGCTIDLENGa; 

inforec  =  record 

trashi,tkash2:  integer; 
errsym,errblk,errnum:  integer; 

TRASH3:  array  C0..23  OF  INTEGER; 

gotsym,gotcooe:  boolean; 

WORKVlDtSYMVlD»CODEVID:  ViD; 
W0RKTID,SYMTID,C0DETI0:  TiD 


(*  ERROR  COM  FOR  EDIT  ♦) 


(*  PERM&CUR  WORKFILE  VOLUMES  *) 
(*  PERM&CUR  WORKFILE  TITLES  ♦) 


fpn 
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i:d 
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0 

i:d 

i+a 

0 

i:d 

49 

0 

i:d 

50 

0 

i:d 

51 

0 

i:d 

52 

0 

i:d 

53 

0 

i:d 

5*+ 

0 

i:d 

55 

0 

i:d 

56 

0 

i:d 

57 

0 

i:d 

58 

0 

i:d 

59 

0 

i:d 

60 

0 

x:d 

61 

0 

i:d 

62 

0 

i:d 

63 

0 

i:d 

64 
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i:d 

65 

0 

i:d 

66 

0 

i:d 

67 

0 

i:d 

68 

0 

i:d 

69 

0 

i:d 

70 

0 

i:d 

71 

0 

i:d 

2 

72 

0 

i:d 

8 

73 

0 

i:d 

54 

74 

0 

i:d 

59 

75 

0 

i:d 

67 

76 

0 

i:d 

68 

77 

0 

i:d 

68 

78 

1 

i:d 

1 

79 
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i:d 

3 

80 

1 

i:d 

3 

81 

1 

i:d 
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END  (*lrJFOKEC*)  ; 

SYSCO:^f^=:C  =  RECOKQ 

JUNK:  ARRAY  C 0 . . 6 3  OF  INTEGER! 
LASTMP:  INTEGER; 

EXPANSION:  ARRAY  CO. .203  OF  INTEGER; 
MISCINFO:  PACKED  RECORD 

N03REAK,STUPID»SL0WTERM, 

HASXYCRTtHASLCCRT,HASB510A»HASCLOCK:  BOOLEAN 
END; 
CRTTYPE:  INTEGER; 
CRTCTRL.:  PACKED  RECORD 

RLF»N0FS,ERASEEOL,ERASEEOS, HOME. ESCAPE:  CHAR; 

BACKSPACE:  char; 
fillcount:  0..255; 
clearscreentclearline;  char; 

prefixed:  PACKED  ARRAY  CO, ,8]  OF  BOOLEAN 

end; 

CRTINFO:  packed  RECORD 

width.height:  integer; 

RIGHT, LEFT. DOWNiUP:  CHAR; 

badch.chardel. stop. break. FLUSH. EOF:  char; 

altmode.linedel:  char; 

backspace. ETx, prefix:  char; 

prefixed:  packed  array  co,,13D  of  boolean; 

END 
END  (*SYSCOM*); 

VAR  {*  T,i|  GLOBALS  AS  OP  30-JAN-78  *) 

syscom:  '^syscomrec; 

trashy:  array  c 0 . . 5 d  of  integer; 

userinfo:  inforec; 

trashyy:  array  co,.4]  of  integer; 

syvid.okvid:  vid; 

thedate:  daterec; 

1  SEGMENT  procedure  EDITOR ( XXX . YYY :  INTEGER); 
3  CONST 

(*  UNLESS  OTHERWISE  NOTED  ALL  CONSTANTS  ARE  UPPER  BOUNDS 
FROvi  ZERO.  *) 
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111 
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113 
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i:d 
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i: 

l: 
i; 
i: 
i; 
i; 
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D 
D 
D 
0 
0 
0 
0 
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i:o 

i:o 

i:d 

i:d 

i:d 

i:d 

i:o 

i:d^ 

i:o 

i:d 

i:d 

i:d 

i:d 

i:d 


1 
i; 

i; 
l; 


D 
D 

D 
D 


i:d 
i:d 
i:d 
i:d 
i:d 


i: 

li 
i: 
i; 


i;d 
i:d 
i:o 
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3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 


i'JlAX8UFsiZE  =  32767; 

MAXSW=S4;  (*  MAXIMUM  ALLOWABLE  SCREENWIDTH  *) 

MAXSTRING=127; 

MAXCHAr=1023;   (*  THE  MAXIMUM  NUMBER 

TIDLENg=15;   (*  FROM  SYSCOM  *) 

(*  FOR  FINAL  VERSION.  NOT  USED. 
{*  MAXIMUM  OFFSET  IN  A  PAGE  *) 
RIDICULOUS  UPPER  BOUNDi  *) 


OF  CHARACTERS  ON  A  LINE  IN  THE  EBUF  *) 


CHARINbUF=2018! 
MAXOFFseT=1023; 
MAXPAGE=255;  (* 


(*  THE  FOLLOWING  ASCII  CHARACTERS  ARE  HARD-WIRED 
HT=9;  LF=10;  E0L=13;  DLE=16;  SP=32; 
DC1=17;  BELL=7;  RUB0UT=127;  CR=13; 


*) 


IN  *) 


CHAR; 
OF  CHAR; 


TYPE 

PTRTYPE=0..MAXBUFSIZE; 
BUFRTYPE=PACKED  ARRAY  CO.. 03  OF 
BL0CKTYPE=PACKED  ARRAY  CO. .5113 

errortype=(fatal. nonfatal) ; 

offset=o..maxoffset; 

page=o.,maxpage; 

NAME=PACKED  ARRAY  CO. .73  OF  CHAR; 

ptype=packed  array  c 0. ,maxstring3  of  char; 
commands=(illegal,adjustc,copyc,deletec,fxndc,insertc,jumpc.listc,macrodefc, 

nSSSS'?c^^p;?^?'-;^"'2^^^*^^"''^^'^^^"^^C'2APC,REVERSEC,F0RWARDC,UP, 

down. LEFT t RIGHT, TAB, DIGIT. DUMPCf ADVANCE, SPACE, EQUALCSLASHC); 
CTYPE=(FS,GOHOME,ETOLOL,ETOEOS,US);  i-cluumui.  .iUAiriL  M 

SCREENC0MMAND=(WH0ME.ERASEEOS,ERASEEOL,CLEARLNE.CLEARSCN,UPCURS0R, 

DOWNCURSOR,LEFTCURSOR,RlGHTCURSOR); 

(BACKSPACEKEY,DC1KEY,E0FKEY,ETXKEY,ESCAPEKEY.DELKEY,UPKEY, 
DOWNKLY,LEFTKEY,RIGHTKEY,NOTLEGAL);  t-rvti  .urr^tT, 


KEYCOMMAND= 


HEADERr     (*  PAGE  ZERO  LAYOUT  CHANGED  22-UUN-78  *) 
RECORD  CASE  BOOLEAN  OF 

true:  (BUF:  packed  ARRAYC0..MAXOFFsET3  of  CHAR); 

false: (DEFINED:     BOOLEAN;  (*  NEW  FILE  NULLS  =>  FALSE  *) 

count:     integer;  {♦  the  count  of  valid  markers  ♦) 

name:        array  C0..9D  of  packed  ARRAY  CO. .73  OF  CHAR; 

pagen:     packed  array  C0..93  of  page; 
poffset:    packed  array  C0..93  of  offset; 
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129 

i:d 

5 

130 

i:d 

3 
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i;o 

3 
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i:o 

3 

153 

i:d 

3 

13H 

i:d 

3 

135 

i:d 

3 

136 

i:d 

3 

137 

i:d 

3 

138 

i:d 

3 

139 

i:d 

1 

ito 

i:d 

5 

mi 

i:d 

6 

ita 

i:d 

7 

lf3 

i:d 

9 

i^+f 

i:d 

10 

115 

i:d 

11 

i^e 

i:d 

12 

I't? 

i:d 

13 

118 

i:d 

If 

149 

i:d 

15 

150 

i:d 

16 

151 

i:o 

17 

152 

i:d 

18 

153 

i:d 

21 

151 

i:d 

80 

155 

i:d 

81 

156 

i:d 

82 

157 

i:d 

83 

158 

i:d 

88 

159 

i:d 

52 

160 

i:d 

52 

161 

i:d 

53 

162 

i:d 

17 

163 

i:d 

ai 

end; 


aijtoinoent  : 
filling: 

TOKDEF: 
LMARSIN: 

rmargin: 

para^^argin: 

runoffch: 

created: 

lastjsed: 

filllR: 


BOOLEA^J;  {* 

booleam; 

BOOLEAN; 
C.MAXSW; 
0. .MAXSW; 
0. .MAXSW J 
CHAR; 

daterec; 
DATErec; 
packed  array 


ENVIRONMENT  STUFF  FOLLOWS 


1  do 


*) 


CO. .891]  OF  CHAR) 


(* 

NUMBER  OF  VALID  CHARACTERS 

(* 

GETLEADING             ♦) 

(* 

SETS       ♦) 

(* 

THESE  *) 

(♦ 


OR 


*) 


(* 

MOVED 

TO 

VAR 

26- 

•JAN 

*) 

(* 

M 

II 

II 

1 

1 

*) 

VAR 

CURSOR:  O..MAXBUFSIZE; 
BUFCOUnt:  O..MAXBUFSIZE; 
STUFFStaRT:  0..f^AXBUFSlZE: 

linestart:  c.maxbufsize; 

BYTES. blanks:  INTEGER; 

ch:  char; 
direction:  char- 
repeatfactor:  integer; 
bufsize:  integer? 
screenwidth:  integer? 
screenheight:  integer; 
command:  commands; 
lastpat:  o.,maxbufsize; 
ebuf:  -bufrtype; 

FILLIT:  STRINGC113! 

kind:  array  cchard  of  integer; 

LINEIPTR:  0..MAXBUFSIZE; 

MIDDLE:  integer; 
needprompt:  boolean; 

ETX,3S,DEL,ESC,BSPCE:  INTEGER; 

adjustprompt,insertprompt,deleteprompt,comprompt:  string; 

CPROMPtlINE   11/2/78  M.  BERNARDD 

trash:  INTEGER;  (*  TOTALLY  WITHOUT  REDEEMING 

TARGET:  ptype; 

substring:  ptype; 

slength.tlength:  integer;     (*  length  of  target  and  substring 


IN  the  ebuf  *5 


{*  FOR  TOKEN  FIND  *) 
(*  MIDDLE  line  ON  THE  SCREEN  *) 
(*  MOVED  FROM  CONST  30-JAN-78  BSPCE:  11/2/78*) 


SOCIAL  VALUE  *) 


*) 
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197 

198 

199 
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201 
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9 

9 

9 

9 

9 

9 

9 

1 

1 

1 

1 

1 
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1 
1 
1 

i: 
i: 
i: 
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i:o 
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i:d 
i:d 
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i:d 
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i:d 
i:d 
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:d 
:5 
:o 
:o 
:o 
:o 
:o 


i:o 
i:o 
i:o 
i:o 
i:o 
2:d 
3:d 
f  :d 
5:d 
6:d 
7:d 


S3 
35 
67 
39 
90 
30 
86 
98 
39 
80 
65 
06 
06 
06 
06 
06 
06 
06 
14 
14 
14 
14 
14 
22 
0 
0 
0 
0 
12 
12 
12 
12 
12 
12 
12 
1 
1 
3 
1 
1 
1 


SDEFIN 
COPYLE 
COPYLI 
INFINI 
THEFIL 
TRANSL 
PAGEZE 

msg:  S 

PROMPT 
6LAhjKA 
SAVETO 
SCREEN 


KEYBRD; 


LDfTOEFIN 
NSTH.CQPY 
MEtCOPYOK 
TY:  300LE 

E:  file; 
ate:  arra 

RO:  HEADE 

tring; 
line:  str 
rea:  arra 

:  STRING 
PACKED 
PREFI 
HEIGH 
CANUP 
HASPR 

ch: 
end; 

PACKED 
PREFI 
HASPR 

ch: 

END? 


ED:  boolean; 

start:  PTRTYPi 

:  boolean; 

AN; 


{*  WHETHER  THE  STRINGS  ARE  VALID  *) 

(*  FOR  COPYC  *) 
(*     "       *) 

(*  FOR  SLASHC  *) 


Y    CCHAR:    OF    COMiViANDS; 

r; 


ING; 

Y    C0..MAXSWD 

1 

RECORD  (*  SCR 
X:  CHAR; 
TtWiDTH:  0,.2 
SCROLL, CANDOW 
EFix:  PACKED 
PACKED 


OF  CHAR; 

(*  DUMB  TERMINAL  PATCH  -  FOR  BLANKCRT(l)  ♦) 
EEN  CONTROL  RECORD  *) 

55; 

NSCROLLtSLOW:  BOOLEAN; 

ARRAY  CSCREENC0MMAND3  OF  BOOLEAN; 

ARRAY  CSCREENC0MMAND3  OF  CHAR 


RECORD  (*  KEYBOARD  CONTROL  RECORD  ♦) 
X:  CHAR; 
EFix:  PACKED 
PACKED 


ARRAY  CKEYC0MMAND3  OF  BOOLEAN; 
ARRAY  CKEYC0MMAND3  OF  CHAR 


SEGMENT  PROCEDURE  NUM2 
SEGMENT  PROCEDURE  NUM4 
SEGMENT  PROCEDURE  NUM6 
SEGMENT  PROCEDURE  NUMS 


(*$I  HEAD  *) 


BEGIN  end; 
BEGIN  END; 
BEGIN  END; 
BEGIN  END; 


SEGMENT 
SEGMENT 
SEGMENT 
SEGMENT 


PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


NUM3; 
NUM5; 
NUM7; 
NUM9; 


BEGIN  ENDt 
BEGIN  END; 
BEGIN  end; 
BEGIN  END; 


(*  FORWARD  DECLARED  PROCEDURES.,  ALL  PROCEDURES  ARE  IN  MISC  AND  UTIL  *) 

PROCEDURE  ERROR(S:STRING;HOWBAD:eRRORTYPE);  FORWARD; 

PROCEDURE  ERASETOEOL(X,LlNE:lNTEGER) ;  FORWARD; 

FUNCTION   GETCH:CHAR;  FORWARD; 

PROCEDURE  CLEARSCREEN;  FORWARD; 

PROCEDURE  ERASE0S(X,lINE:INTE6ER);  FORWARD; 

PROCEDURE  CLEARLINE{y:INTEGER) ;  FORWARD; 
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223 
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223 

229 
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231 

231 

232 

233 

234 

235 

236 

237 

238 
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241 
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10 

10 
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10 
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8: 

9: 
10: 
ii: 
12: 
13: 
14: 
15; 
16: 
17: 
18: 
19: 
2o:c 
2i:d 
22:d 
22:d 
23:d 
24:d 
25:d 
26:o 
27:d 
28:o 
29:d 
3o:d 
3i:d 
32:d 
32:d 


32 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
2 
2 


:d 
:d 
:d 
:o 
:d 
:d 
:d 
:d 
:d 
:d 
:o 
:d 
:d 
:o 


3 

1 
1 
3 
3 
3 
3 
1 
1 
1 
1 
1 
3 
1 
4 
1 
1 
3 
1 
3 
1 
1 
1 
1 
1 
44 
44 
1 
1 
1 
1 
2 
3 
5 

6 

12 

53 

65 

1 

0 


FUNCTION 
FUNCTlorj 
PROCEDUKl 
PROCEDURE 
FUNCTION 
FUNCTION 
FUNCTION 
FUNCTION 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTION 
PROCEDURE 
FORWARD; 
PROCEDURE 
PROCEDURE 
FUNCTION 
PROCEDURE 
FUNCTION 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 

(*$I  INIT 

SEGMENT  PR 
LABEL  1; 
VAR 

block:  '^ 
onewd:  " 

DONE.OVF 

ch:  char 

I»QUIT,G 
FILENAME 
BUFFER: 

PROCEDURE 
BEGIN 


:maptoc0wmand(ch:char)  :  com^ianos;  forward; 
uclc(ch:char) :  char;  forward; 
pro;mpt;  forward; 

REDISPLAY;  forward; 
MIiM{At3:iNTEGER)  :  INTEGER;  FORWARD; 

max (a, a: integer ) :  integer;  forward; 

screenhas(what:  screencommand) :  boolean;  forward; 

haskey(what:  keycomimand)  :  boolean;  forward; 

control(what:  screencoi^imand)  ;  forward; 

PUTi^SG;  forward; 

home;  forward; 

errwait;  forward; 

blankcrt(y:  integer);  forward; 

leadblanks(prr:ptrtype;var  bytes:  integer):  integer; 

centercursortvar  line:  integer;  linesup:  integer; 


FORWARD; 
NEWSCREENIBOOLEAN) ; 


FINDXY(VAR  INDENT^LINE:  INTEGER);  FORWARD; 
SHOWCURSOR;  FORWARD; 

getnum:  integer;  forward; 
getleading;  forward; 

oktodel<cursor,anchor:ptrtype) :boolean;  forward; 
lineoutcvar  ptr:ptrtype;  bytes, blanks* line:  integer);  forward; 
upscreen(firstline»wholescreen:boolean;  line:  integer);  forward; 
readjust(cursor:  ptrtype;  delta:  integer);  forward; 
thefixer(paraptr:  ptrtype;rfac:  integer;whole:  boolean);  forward; 
getname(msg:string;  var  m:name);  forward; 


*) 

ocedure 


initialize; 


blocktype; 
integer; 
lw:  boolean; 
; 

AP,BLKS,PAGE»NOTNULS:  INTEGER; 

:  string; 

packed  array  CO. .10233  OF  CHAR; 

map(ch:char;  c:commands); 
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285 
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2:i 
2:1 
2:0 
2:0 
3:d 
3:0 

3:1 


3; 
3; 
3; 
3; 
3; 
3: 
3: 


3:1 
3;2 
3:3 
3:3 
3:3 
3:3 
3:2 
3:0 
3:0 
4:d 
4:0 
4:1 
4;i 
4:i 
4:1 
4:1 
4:1 
4:1 
f:i 
4:2 
4:3 
4 


!4 

:5 
:6 


4:6 
4:6 


0  TRANSLATElCCHjrrC; 

8    IF  CH  IN  [•A',.«Z«D  THEN  TRAMSLATEC CHR ( 32+ORD ( CH ) ) : ; =C ;  (*  LC  TOO  *) 

3B  end; 

50 

1  PROCEDURE  DEFPRO:^PTS;  (*  DEFINES  VARIABLE  PROMPTL.INES  MAB  11/2/78*) 
0  BEGIN 

0    COMPROVipT:  = 

3  •  edit:  A(DJST  C(PY  D(LETE  F(IND  KNSRT  J(MP  R(PLACE  Q{UIT  X(CHNG  Z(AP   CE.6F3»; 

insertprompt:= 

•  insert:  text  C<BS>  a  CHAR,<DEL>  a  LINE3   C<ETX>  accepts,  <ESC>  ESCAPES]*; 

deleteprompt:= 

•  delete:  <  >  <M0VING  COMMMANDS>  C<ETX>  TO  DELETE,  <ESC>  TO  AB0RT3M 

adjustprompt:= 

•  adjust:  L(JUST  R(JUST  C(ENTER  <LEFT, right, up, D0WN-ARR0WS>  C<ETX>  to  LEAVE3*; 

IF  (SCREENWIDTH+1)<LENGTH(C0MPR0MPT)  THEN 
BEGIN 

INSERTPR0MPT:='  INSRT:  C<BS>,<DEL>3  C<ETX>  ACCEPTSi  <ESC>  ABORTS]'; 

deleteprompt:='  delete:  <vector  keys>  c<etx>  deletes.  <ESC>  ABORTSD*; 
adjustprompt:=»  adjst:  lcft  r(ght  c(ntr  <vector  keys>  <etx>  to  leave* s 
comprompt:=»  edit:  a,  c,  d,  f,  i,  j,  r,  q,  x,  z  ce.6F3»; 

END; 

62  end.; 

76 

1  procedure  readfile; 

0  BEGIN 

0   clearscreen;        (*  dumb  terminal  patch  *) 
writelnoedit:'); 

WRITE( •READING') ; 

IF  BL0ckREAD(THEFIlE.PAGEZER0,2)<>2  THEN  ERR0R{ 'READING  FILE' , FATAL) ; 
WRITEC.')  ; 

page:=i; 

done:=false;  ovflw:=false; 

WITH  UseRINFO  do 

while  not  (done  or  ovflw)  do 
begin 

DONE:=  BL0CKREAD(THEFILE, BUFFER, 2 )=0; 

if  not  done  then 
begin 

WRITE( ',») 5 

NOTNULS :=SCAN( -1024. <>CHR{0),BUFFERC 10233) +1024; 

OVFLW:=NOTNULS+BUFCOUNT>=BUFSIZE-10; 


85 
88 
65 
68 
38 
41 
21 
32 
32 
90 
50 
11 
62 


3 

25 
42 
83 
91 
95 
03 
03 
13 
13 
36 
42 
42 
50 
72 


i2n 


236       10  4:6  8*+ 

287       10  4:6  ^3 

4:6  05 

4:6  25 

290  10  4:6  62 

291  10  4:5  40 


130 

IF    OVFLW    THEN    rJOTr\JULS  :  =0  ! 

2^;,  tn  Z'^            of                                   HOVELEFT(t3UFFER[:03,E3UF-CBUFcOUNTJ,NoTNULS); 

239  in  V'l            ^l                                   ^^    PAGE+PAGE=ERRBLK    THEW    CURSOR : =BUFCOUNT+ERRSYM ;     (*    ERRBLK>0    ONLY    *) 

'^'^^  ^^  "^'^            '^^                                     BUFCOUiMT:=BUFCOUNT  +  MOTrJULS; 

page:=page+i; 

292  10  4:3  40        EfMD; 

pin  \l  "irA  "?    ^''  lORESULTOO  THEN  LRRORCDISK  ERROR  •  .NONFATAL )  ELSE 

295  in  I'.l  al   Mn  ^^  ^""^  °°'^^^  ^^^^^  ERROR  ('BUFFER  OVERFLOW.  •,  NONFATAL )  ; 
c-^J  J.  u  t ,  u  96  END; 

296  10  4:o  12 

297  10  5:d      1  PROCEDURE  LOADFROMSYSCOM ; 

299  l2  5.'n      1  ^*  A^m^^n^n/rT^"I^^  PROCEDURE  THAT  TAKES  THE  SYSCOM«. CRTCNTRL  RECORD 

300  \l  V-rs              \            Jt^    ^J^^^^    ^^    ^'^^°  ^^^  ^^^^^^^  CONTROL  RECORD  AND  THE  SYSCOM^.CRTINFO 
\l\  \l  \\l              \      _«^CORD  AND  LOADS  IT  INTO  THE  KEYBOARD  CONTROL  RECORD  *) 

'^^^  iu  o.o      0  BEGIN 

302  10  5:o      0 

202  10  5:i    0   WITH  syscom'^  do 

^O'^  10  5:2      5      BEGIN 

305  10  5:2      5 

306  10  5:2      5        (*  MISCELLANEOUS  STUFF  *) 

307  10  5:2      5 

fOQ  10  5:3      5        WITH  SCREEN  DO 

309  10  5:4      5          BEGIN 

^11  rl  =:?      ^            PREFIX:=CRTCTRL, ESCAPES 

V:\  JO  ^'5  1**        height:=crtinfo.height-i; 

^Vx  in  ='^  ^^        wioth:=crtinfo.width-i; 

%\i  in  =:?  !!        canupscroll:=true;  candownscroll:=false; 

^^^  10  5:4  50        t"N0; 

315  10  5:4  50 


316  10  5:3  50 

317  10  5:3  59 

318  10  5:3  59 

319  10  5:3  59 

320  10  5:3  59 

321  10  5:3  70 

322  10  5:3  86 

323  10  5:3  86 

325  10  5-3  ^3        SCREEN. HASPREFIXCERASEEoS3:=CRTCTRL.PREFIXEDC3J5 

326  10  5:3  13 


KEYBRD. PREFIX :rCRTlNFO. PREFIX; 
{*  THE  SCREEN  ...  *) 

SCREEN. CHCWHOME 3 :=CRTCTRL. HOME; 

SCREEN. HASPREFIXCWHOME 3: =CRTCTRL.PREFIXEDC43; 


SCREEN. CHCERASEEOS 3 :=CKTCTRL.ERASEEOS; 
SCREEN.HASPREFIXCERASEE0S3:=CRTCTRL.PR 

SCREEN. CHCERASEEOL 3: =CRTCTRL.ERASEEOL; 


327 

10 

5:3 

24 

328 

10 

5:3 

40 

329 

10 

5:3 

40 

330 

10 

5:3 

51 

331 

10 

5:3 

67 

332 

10 

5:3 

67 

333 

10 

5:3 

78 

33«+ 

10 

5:3 

94 

335 

10 

5:3 

94 

336 

10 

5:3 

05 

337 

10 

5:3 

21 

338 

10 

5:3 

21 

339 

10 

5:3 

27 

340 

10 

5:3 

36 

3tl 

10 

5:3 

36 

3f2 

10 

5:3 

47 

3«+3 

10 

5:3 

63 

344 

10 

5:3 

63 

3t5 

10 

5:3 

74 

346 

10 

5:3 

90 

347 

10 

5:3 

90 

348 

10 

5:3 

90 

349 

10 

5:3 

90 

350 

10 

5:3 

98 

351 

10 

5:3 

14 

352 

10 

5:3 

14 

353 

10 

5:3 

20 

354 

10 

5:3 

29 

355 

10 

5:3 

29 

356 

10 

5:3 

40 

357 

10 

5:3 

56 

358 

10 

5:3 

56 

359 

10 

5:3 

67 

360 

10 

5:3 

83 

361 

10 

5:3 

83 

362 

10 

5:3 

94 

363 

10 

5:3 

10 

364 

10 

5:3 

10 

365 

10 

5:3 

21 

366 

10 

5:3 

37 

367 

10 

5:3 

37 

SCf<EEN.HflSPREFIXCERASEE0L3:=CRTCTRL.PREFlXEDC2J; 

SCREEN. chcclearlned:=crtctrl.clearline; 

SCREEN.  HASPREFlXCCLEARLrjE  3  :=CRTCTRL.  prefixed:  7:1; 

screen.chcclearscn:]:=crtctrl.clearscreen5 
screen.hasprefixi:clearscnj:=crtctrl.prefixedc6  3} 

screen. chcupcursord:=crtctrl.rlf; 
screen.hasprefixcupcursoR3:=crtctrl,prefixedcod; 

screen. CHCD0WNCURS0R3:=CHR(LF) ; 

screen. hasprefixcdowncursor 3 :=false; 

screen. CHCLEFTCURSOR 3 :=CRTCTRL. BACKSPACE  5 

screen. HASPREFIXCLEFTCURS0R3:=CRTCTRL,PREFIXEDC13; 

SCREEN. chcrightcursor 3 :=crtctrl.ndfs; 
screen,hasprefixi:rightcursor]:=crtctrl.prefixedc8D5 

{*  ...  and  the  keyboard  *) 

KEyBRD,CHCBACKSPACEKEY3:=CRTINF0. BACKSPACE; 
KEybRD.HASPREFIXCBACKSPACEKEY3:=CRTINF0,PREFIXEDC123; 

KEYBRD,CHCDClKEYa:=CHR(DCl);  ( *  NOT  IN  RECORD  *) 
KEYBRD,HASPREFlXCDClKEY::rFALSEj 

KEYBRD.CHCEOFKEY3:=CRTINFO.EOF! 

keybRd.hasprefixceofkey::=crtinfo. prefixed: 9D ; 

KEYBRD.CHCETXKEY3:=CRTINF0.ETX; 
KEybR0.HASPREFIXCETXKEY3;=CRTINF0. prefixed: 13D; 

keybrd,chcescapekeyd:=crtinfo.altmode{ 
keybrd.hasprefixcescapekey::=crtinfo. prefixed: 10 3; 

keybRd.ch:delkey3:=crtinfo.linedel; 

KEY3RD.HASPREFIXCDELKEY3;=CRTINF0,PREFIXED:11J{ 

keybrd.ch:upkey3:=crtinfo.up; 


iSl 


133 

368  10  5:3  ^^8        KEY3KD.HASPREFIXCUPKEY3:=CRTINF0.PRE:FIXEDC3]; 

369  10  5:3  64 

370  10  5:3  6^+        KEY3»^D,CHC00WNKEYD:=CRTINF0. DOWNS 

371  10  5:3  75        KEY3RD.HASPREFIXCDOWMKEYD:=CRTINFO,PREFIXEDC23; 

372  10  5:3  91 

373  10  5:3  91      key3Rd.chcleftkey::=crtinfo.left; 

^^'t  10  5:3  02        KEYBRD.HASPREFIXLLEFTKEY3:=CRTINF0.PREFIXEDC13; 

375  10  5:3  18 

376  10  5:3  13        KEY3RD,CHCRIGHTKLYD:=CRTINF0. RIGHT; 

377  10  5:3  29              keybRd.hasprefixi:rightkeyj:=crtinfo.prefixedco3; 

378  10  5:3  f5 

379  10  5:3  i+S        BSpcE:=ORD(CRTINFO. BACKSPACE);   CWENT  SOFT  11/2/78  M.  BERNARDD 

380  10  5:3  51 

381  10  5:3  51        CNOW  TEST  TO  SEE  THAT  THE  ESSENTIAL  KEYS  HAVE  BEEN  GIVEN  A 

382  10  5:3  51         VALUE  OTHER  THAN  NULL.   IF  NOT  THEN  ASSIGN  THEM  A  DEFAULT 

383  10  5:3  51         VALUE.   HOPEFULLY,  THiS  WILL  END  UP  AN  INTERP  CHANGE— M.  BERNaRDD 

384  10  5:3  51 

385  10  553  51         IF  BSPCE=0  THEN  BSPCE:=8; 

386  10  5:3  62         IF  KEYBRD.CHCETXKEY3=CHR(0)  THEN  KEYBRD.CHCETXKEY3I=CHR (3 ) 5 

387  10  5:3  77 

388  10  5:3  77 

389  10  5:2  77      end; 

390  10  5:0  77  end; 

391  10  5;o  90 

392  10  6:d    1  procedure  mapspecial(k:keycommands;c:commands); 

393  10  6;o      0  begin 

394  10  6:1      0    IF  NOT  kEYBRD.HASPREFIXCKD  THEN  MAP(KEYBRD.CHCK3f C) ; 

395  10  6:0  19  END; 

396  10  6:0  32 

397  10  1:0      0  BEGIN 

398  10  1:1      0    WITH  PAGEZERO  DO 

399  10  1:2      0      BEGIN 

too  10  1:2    0 

'♦01  10  1:2      0        (*  LOAD  SCREEN  AND  KEYBOARD  CONTROL  RECORDS  FROM  SYSCOM  *) 

'♦02  10  1:2      0 

'^o^  10  1:3     0       LOadFROMSYSCOM; 

f04  10  1:3  2 

405  10  1:3  2 

'^OS  10  1:3  2        {*  iNIT  THE  TRANSLATE  TABLE  *) 

^♦07  10  1:3  2 

'+03  10  1:3  2        FlLLCHAR{TRANSLATE,SlZEOF(TRANSLATE)tILLEGAL)  ; 


<+09 

10 

1:3 

12 

flO 

10 

113 

21 

'+11 

10 

1:3 

36 

'*12 

10 

1:3 

13 

113 

10 

1:3 

60 

mtf 

10 

1:3 

72 

tflS 

10 

1:3 

81 

416 

10 

1:3 

96 

t+lT 

10 

1:3 

08 

118 

10 

1:3 

08 

i+ig 

10 

1:3 

08 

120 

10 

1:3 

08 

121 

10 

1:3 

08 

122 

10 

1:3 

08 

123 

10 

1:1 

08 

121 

10 

1:5 

08 

125 

10 

115 

16 

126 

10 

1:1 

21 

127 

10 

1:3 

21 

126 

10 

1:3 

28 

129 

10 

1:3 

32 

130 

10 

1:3 

36 

131 

10 

1:3 

36 

132 

10 

113 

36 

133 

10 

1:3 

36 

131 

10 

1:3 

36 

135 

10 

1:3 

61 

136 

10 

1:3 

61 

137 

10 

1:3 

61 

138 

10 

1:3 

61 

139 

10 

1:3 

61 

110 

10 

1:3 

61 

111 

10 

70 

112 

10 

71 

113 

10 

77 

111 

10 

77 

115 

10 

81 

116 

10 

89 

117 

10 

91 

118 

10 

09 

119 

10 

18 

MAp( M* .ADJUSTC) ;  MAP( 

^AP(  •FSFINDC)  ;  MaP( 

MAP( 'L'tLISTC) ;  MAP( 

MAP( 'Q' , QUITO ;  MAP( 

MAP( 'VNVERIFYC)  ;  MAP( 

MAP( •, '.REVERSEO ;  MAP(' 

MAP( •+»,FORWARDC);  MAP(' 

MAP( •/♦ fSLASHC) ;  MAPC 


'CCOPYO  ; 
'I'.INSERTO  ; 
'M»  ,V!ACRODEFC) 

R'iREPLACEC) ; 

X»,XECUTEC) ! 

>• ,FORWARDC)  ; 

-•tREVERSEC) ; 

=»,EQUALC) ; 


MAP( •D»,DELETEC)  ; 
MAP(»Jt,juMPC) ; 
MAP('P»,PARAC) ; 
MAP(»SSSETC)  ; 

•ZSZAPC) ; 

.•iFORWARDC) ; 
MAP{  'TSDUMPO  ; 
MAP(»<»,REVERSEC> J 


MAP( 
MAP( 


AND  GETNUM  HANDLE  VT-52  STYLE  VECTOR  KEYS  ♦) 


{*  ARROWS  *) 

{*  NEXTCOMMAND 
WITH  KEYBRD  DO 
BEGIN 

MAPSPECIAL(UPKEY.UP) ;  MAPSPEClAL(DOWNKEYtDOWN) ; 

MAPSPECIALCLEFTKEY.LEFT) ;  MAPSPECIAL (RlGHtKEY, RIGHT) 
END  i 

MAP(CHR{EOL), ADVANCE);  (*  CR  IS  ADVANCE  *) 

MAP{CHR{HT),TAB)5 

MAP(CHR(SP), SPACE); 


(*  DIGITS  *) 

FOR  CH:=«0'  to  *9*    DO  MAP ( CH. DIGIT) ; 

(*  VARIABLE  BUFFER  SIZING...  ADDED  17-JAN-78  *) 


(*  SI2E0F(EDITC0RE)-SIZE0F(INITIALIZE)  *) 
{♦  SLOP!  *) 


QUIT:=10512+ 
512; 

mark(ebuf); 
blks:=o; 

REPEAT 

NEWCBLOCK) ; 

BLKS:=BLKS+l; 

SAP :=MEMAVAIL+MEMA VAIL 
UNTIL  {{GAP>0)  AND  (GAP<QUIT))  OR  (BLKS=63); 
BUFSIZE:=BLKS*512-1;  ' 

NEW(ONEWD);  ONEWD-:=0;   (♦  SENTINEL  FOR  END  OF  BUFFER  -  FOR  M(UNCH  *) 


iofe 


^+50   10 

1:3 

26 

^+51   10 

1:3 

26 

^^52   10 

1:3 

26 

<*56       10 

1:3 

cfo 

15^   10 

1:3 

26 

^55       10 

1:3 

26 

'+56   10 

1:3 

33 

'+57   10 

1:4 

45 

'+58   10 

1:3 

56 

'+59   10 

1:4 

59 

^+60   10 

1:3 

64 

'+61   10 

1:3 

73 

'+62   10 

1:3 

78 

'+63   10 

x;3 

81 

^+61+   10 

1:3 

34 

465   10 

1:3 

87 

'+66   10 

1:3 

09 

^+67   10 

1:4 

14 

'+68   10 

1:5 

14 

'+69   10 

1:5 

60 

t+TO   10 

1:4 

84 

"+71   10 

1:3 

87 

'+72   10 

1:4 

39 

^+73   10 

1:5 

89 

'+74   10 

1:5 

^92 

475   10 

1:5 

H67 

476   10 

1:6 

67 

477   10 

1:6 

63 

478   10 

1:6 

95 

479   10 

1:6 

H,  10 

480   10 

1:7 

18 

481   10 

1:8 

18 

482   10 

1:7 

30 

483   10 

1:6 

30 

484   10 

i;6 

49 

485   10 

1:6 

49 

486   10 

1:6 

86 

487   10 

1:6 

08 

488   10 

1:7 

27 

489   10 

1:6  ' 

■  62 

490   10 

i;7 

73 

FRONT  OF  ALL  CONTROL  CH'S*) 


(*    OPEN    THE    WlORKFILE    *) 

(*INIT  FILLIT  FOR  WRITING  NULLS  IN 
FILLCHAR(FILLIT,SIZEOF(FILLIT),0); 
IF    SYSCONr.CRTCTKL.FILLCOUNT<=ll    THEN 

FILLITC0  3:=CHR(SYSCOM-.CRTCTRL.FILLCOUNT) 

FILLITC03:=CHR(11); 

FILLCHAR(EBUF-,BUFSIZE+1,CHR(0)); 
E8uF''C0:]:=CHR(EOL); 

bufcount:=i; 

cursor:=i; 

cleaRScreen; 

WRITELN(  OEDITIM  ; 
IF    USERINFO.GOTSYM    THEN 
3EGIN 

ELSE 
BEGIN 

msg:  = 

•NO^WRKPILE    IS   PRESENT.    FILE7    .    <nZT>   FOR   NO   PILE    <ESC-RET>    TO   EXIT    ,    •  = 

WRITELN((«!SG); 
WRITEC:     •); 

REAOLNdNPUT. FILENAME); 
IF    LENGTH(FILENAME)=0    THEN 
BEGIN 

^^FILLCHAR(pAGEZERO,SIZEOF(PAGEZERO),CHR(0));    GOTO    l; 

IF  FILENAMECLENGTH(FILENAME)D=».»  THEN 
DELETE{FILENAME,LENGTH{FILENAME),1){ 


i+Sl 

10 

1  I  b 

83 

i+92 

10 

116 

93 

f93 

10 

ir^j 

kO 

49'+ 

10 

1:4 

26 

^+95 

10 

1:4 

^-26 

i+gs 

10 

1:4 

26 

1+97 

10 

1:4 

26 

f93 

10 

1:4 

26 

<+99 

10 

1:3 

26 

500 

10 

1:3 

28 

501 

10 

1:4 

42 

502 

10 

i;5 

42 

503 

10 

1:5 

47 

504 

10 

1:4 

52 

505 

10 

1:4 

52 

506 

10 

1:4 

52 

507 

10 

1:4 

52 

508 

10 

1:4 

52 

509 

10 

1:3 

52 

510 

10 

1:3 

55 

511 

10 

1:3 

58 

512 

10 

1:3 

62 

513 

10 

1:3 

66 

51tf 

10 

1:3 

66 

515 

10 

1:3 

66 

516 

10 

1:4 

74 

517 

10 

1:5 

74 

518 

10 

1:5 

85 

519 

10 

1:5 

96 

520 

10 

1:5 

07 

521 

10 

1:5 

15 

522 

10 

1:5 

23 

523 

10 

1:4 

31 

524 

10 

1:3 

31 

525 

10 

1:3 

39 

526 

10 

1:3 

45 

527 

10 

1:3 

54 

528 

10 

1:3 

54 

529 

10 

1:3 

56 

530 

10 

1:3 

64 

531 

10 

i;4 

64 

OPENOLDdHLFlLE, FILENAME)  ; 

msg:  =  »imot  present,  fil^'  ♦; 

UNTIL  IORESULT=o; 

EijD; 


(*  read  in  the  file  *) 

dfile; 

IF    (EBUF'^CBUFCOUNT-nOCHRfEOD)    OR    {BUFC0UNT=1)    THEN 


REadfile; 
1: 

BE 

ebuf'^cbufcountd:=chr{eol)  ; 
bufcount:=bufcount+i; 

enO; 


(*  initialize  everything  ELSE!  *) 

direction:=»>»; 

cSpmllFiLSEt    ^"^    ^°    ^""^    BEGINNING    OF    THE    BUFFER    (FOR    EQUALC )    *) 

lineiptr;=i; 

**  jECORDS°.r^  ^^^  ^°  through  THE  SCREEN  AND  KEYBOARD  CONTROL 

WITH  SYSCOM'^.CRTINFO  DO 
BEGIN 

ESC:=ORD(ALTMODE); 
BS:=ORD(CHARDEL); 

del:=ord(linedel) J 
screenwidth:=width-i; 
screenheight:=height-h 
middle:=(screenheight  div  2)  +  u 

END; 

MlpicS"?BSnLr?TM'"'"''""  """"'"  ""^  ''^"''  ASSIGNMENT  U/2/78  «AB3 
S?s«H-!Mfsci'F'j:NOBRE.K  ==  TRUE,       '*  ""''  B*"^"^^  '<^''  "«  NOW  .) 

CINCLUDING  the  command  prompt  LINEn 

defprompts; 

w?th^PAGE2ER0^D0  ^°^^^'^"-=f^'^'-SE;  (*  no  SUBSTRING  OR  TARGET  *) 

IF  NOT  defined  THEN 


i^S 


532 

10 

1:5 

70 

533 

10 

1:6 

70 

5514 

10 

1:6 

60 

535 

10 

i:& 

96 

536 

10 

1:6 

00 

537 

10 

i:& 

12 

538 

10 

1:6 

24 

539 

10 

1:5 

28 

5f0 

10 

1:2 

28 

511 

10 

i;2 

28 

5^+2 

10 

1:2 

28 

5*13 

10 

1:2 

28 

S^ff 

10 

1:2 

28 

545 

10 

1:1 

28 

546 

10 

1:1 

58 

547 

10 

1:1 

86 

548 

10 

1:1 

14 

549 

10 

1:1 

42 

550 

10 

i;i 

56 

551 

10 

1:1 

66 

552 

10 

1:1 

74 

553 

10 

1:0 

74 

554 

10 

1:0 

06 

555 

10 

1:0 

06 

556 

10 

1:0 

06 

556 

10 

1:0 

06 

557 

11 

i:d 

3 

558 

11 

i:d 

3 

559 

11 

i:d 

3 

560 

11 

i:d 

3 

561 

11 

i:d 

4 

562 

11 

i:d 

5 

563 

11 

i:d 

17 

564 

11 

1:0 

0 

565 

11 

i:i 

0 

566 

11 

1:1 

3 

567 

11 

1:2 

3 

568 

11 

1:2 

6 

569 

11 

1:2 

20 

570 

11 

1:2 

36 

571 

11 

1:2 

87 

END  ( * 


BEGIN 

FILLCHAR(BUF,1024,CHR(0) ) ; 

CREATED :=thedate;  lastused:=thedate; 

tokdef:=true;  {*  default  mode  is  T(0KEN  *) 

filling:=false;  autoindent:=true;  RUnoffch:="^» ; 

lmargin:=o!  paramargin:=5;  rmargin:=screenwidth; 

defined:=true; 
end; 
WITH  *) ; 


1  Jo 


(*  INITIALIZE  THE  KIND  ARRAY  FOR  TOKEN  FIND  *) 


FOR  CH:=CHR(0) 

FOR  ch:=«a«  to 
FOR  ch:=»a'  to 
FOR  ch:=»o'  to 


to  CHR{255)  do  KINDCCHD:=0RD(CH) ; 
♦Z»  DO  KINDCCH3:=0RD('A») J 

'z»  DO  kindcch3:=ord( 'am; 

♦9»  DO  KXNDCCH3:=0RD{«A»)5 


{*  make  them  all  unique  *) 


kind[:chr(Eol)3:=ord('  m;  kindcchr(ht)3  :=ord(' 

FILLCHaR(BLANKAREA,SIZEOF(BLANKAREA) » ♦  ♦ )  ; 

savetop:=»»; 

END{*  initialize  *) ; 


{♦$1  INIT       *) 
(♦$1  OUT       *) 

SEGMENT  FUNCTION  OUT;  BOOLEAN; 
LABEL  1,2! 

var 

save:  ptrtype; 

i:  INTEGER; 

BUF;  PACKED  ARRAY  CO. .10233  OF  CHAR; 

FN:  STRING; 
BEGIN 

out:=false; 

REPEAT 

clearscreen;     (*  dumb  terminal  patch  *) 
savetop:='>quit: t ; 

WRITelN(SAVETOP); 

writelnc    U(pdate  the  workfile  and  leave*); 
writelnc    £(xit  without  updating*); 
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11 
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30 
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1:2 

69 
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11 
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575 

11 

1:1 

54 

576 

11 

1:1 

74 

577 

11 

1:1 

61 

578 

11 

1:1 

9f 

579 

11 

1:1 

01 

560 

11 

1:2 

06 

581 

11 

1:3 

06 

582 

11 

1:3 

09 

583 

11 

1:3 

13 

58i+ 

11 

1:3 

6tf 

585 

11 

1:3 

30 

586 

11 

1:3 

91 

587 

11 

i;3 

31 

588 

11 

1:3 

63 

589 

11 

lit 

77 

590 

11 

1:3 

If 

591 

11 

1:2 

39 

592 

11 

1:1 

39 

593 

11 

1:2 

41 

59tf 

11 

1:1 

65 

595 

11 

1:1 

69 

596 

11 

1:1 

86 

597 

11 

1:1 

97 

598 

11 

1:1 

05 

599 

11 

1:1 

29 

600 

11 

1:1 

37 

601 

11 

1:1 

40 

602 

11 

1:2 

49 

603 

11 

1:3 

49 

60^ 

11 

1:3 

67 

605 

11 

1:3 

80 

606 

11 

1:3 

94 

607 

11 

i;3 

17 

608 

11 

1:3 

26 

609 

11 

1:2 

34 

610 

11 

1:1 

36 

611 

11 

1:2 

41 

612 

11 

1:3 

41 

TOi't^'n!.'      Si^lT?"  ^°    ^"-  ""O"  "T"0"T  UPDATING.  )1 

UNTIL  CH  IfJ  C'U«  t 'E'f 'R»,«W»  J; 
IF  CH=»R»  THEN  GOTO  2; 

CLOSEaHEF™","'""  ™T:=TRUE,-  CLWRSCREEN,  goto  2  END.- 

IF  CH='W*  THEN 
BEGIN 

save:=cursor; 
blankcrtci) ; 

r'JS;^;  °'  °'''''  "'"'  ^<">  ''  ^^'^^"^^     ->'" 

IF  LENGTH(FN)=o  then  GOTO  2; 

Tc^  J;""!  ^°  LENGTH(FN)  DO  FNC  I  3:=UCLC  (FNC  13)  ; 

IF  (<P0S{».TEXT'.FN)<>LENGTH(FN)-4)  OR  aENGTH(FN)<-4)l  ANn 
(FNCLENGTH(FN)3<>',»)  THEN  t  "-'^»Mfc' 1  H(FNK-4) )  AND 

fn:=concat{fn.'.text«); 

EN^  f'^'^'-^'^'5T"<''N)3=...  THEN  DELETE{FN,LENGTH(FN)  .1)  ; 
ELSE 

fn;  =  »«system.wrk.text»  j 

BLANKCRT(l); 

write(»wRIting»); 

0PENNEW(THEFILE»FN); 

pagezero.lastused:=thedate; 

CURS0R;=1J ' 

WHILE  CURSOR  <  BUFCOUNT-1023  DO 
BEGIN 

i:=SCAN(-1022,=CHR(EOL)  ,E3UF'^CCURS0R  +  1022D)  J 

MOvELEFT(E8UF-|:CURSORD.BUFa023+liJ 

FlLLCHAR{8UFCl023+n,ABS(I)+l.CHR(0))l 

IF   BL0CKWRITE(THEFILE,BUF,2)    <>    2    THEN   GOTO    U 

CUrs0R:=CURS0R+1023+I;  ^°   °    ^' 

wRitec.m; 

end; 

if  curs0r<bufc0unt  then 

BEGIN 

FILLCHAR(BUF.SIZEOF(BUF),CHR(0)); 
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613 

1:3 

50 

6m 

1:3 

61 

615 

1:2 

92 

616 

1:1 

92 

617 

1:1 

99 

613 

1:1 

05 

619 

1:1 

o4 

620 

1:2 

69 

621 

1:3 

69 

622 

1:4 

69 

623 

1:4 

04 

62^ 

1:4 

38 

625 

1:3 

53 

626 

1:1 

53 

627 

1:2 

55 

628 

1:3 

55 

629 

1:3 

17 

630 

1:3 

48 

631 

1:3 

53 

632 

1:2 

56 

633 

1:1 

56 

63<f 

1:1 

58 

635 

1:1 

85 

636 

1:1 

12 

637 

1:1 

12 

638 

111 

12 

639 

1:1 

12 

639 

1:1 

12 

6<fO 

12 

i:d 

1 

641 

12 

i:d 

1 

6*^2 

12 

i:d 

1 

643 

12 

1:0 

1 

644 

12 

i:d 

10 

645 

12 

i:d 

12 

646 

12 

i:d 

24 

647 

12 

i:d 

32 

648 

12 

i:d 

73 

649 

12 

i:d 

13 

650 

12 

2:0 

1 

651 

12 

2:0 

0 

652 

12 

2:1 

0 

fj|oveleft(ebuf*ccursor:»bjf,sufcount-cursor)  ; 
if  bl0ck^rite{thlfile.buf.2)  <>  2  then  goto  ij  writec,') 
end; 
close(thefile.lock) ; 

WRITELN; 

WRITELN( 'YOUR  FILE  IS  SBUFCOUNT*'  BYTES  LONG.'); 

IF  CH=»U'  THEN 

WITH  USERINFO  DO 
BEGIN 

symvid:=syvid;   symtid:=»system.wrk.text» ;   gotsym:=true; 
openold(theflle.'*system,wrk.codem ;  close ( thefile. purge ) ; 
gotcode:=false;  codetid:  =  ";  out:=true5 

END 
ELSE 
BEGIN 

WRITECDO  YOU  WANT  TO  E(XIT  FROM  OR  R(ETURN  TO  THE  EDITOR?  ')! 
REPEAT  CH:=UCLC(GETCH)  UNTIL  CH  IN  C'E»»'R'3; 
out:=  CH='E»; 

CURS0R:=SAVE;  (*  QW  RETURNS  TO  THE  EDITOR  *) 
END; 
GOTO  2}  (*  SORRY  ABOUT  THAT  EDSGER  *) 
1:  ERROR( 'WRITING  OUT  THE  FILE ' .NONFATAL) ; 
2:end; 


(*$I  OUT        *) 

(*$I  copyfile  *) 

SEGMENT  PROCEDURE  COPYFILE; 

VAR 

STARTP AGE. STOPPAGE ♦STARTOFFSET.STOPOFFSET. 

LEFTPART.PAGE.N0TNULLS,THEREST,LM0VE:  INTEGER! 

DONE.OVFLWJ  BOOLEAN? 

BUFR:  PACKED  ARRAY  CO. ,10233  OF  CHAR; 

STARTMARK.STOPMARK:  packed  array  CO. .73  OF  CHAR; 

FN:  STRING; 

f:  file; 

PROCEDURE  ERRMARKER; 
BEGIN 

ERR0R( 'IMPROPER  MARKER  SPECIFICATION. '« NONFATAL ) ; 


6^3   12  2:i  37    EXIT(COPYFILE) 

65'+  12  2:(!  m  end; 

655  12  2:n  b't 

656  12  3:D      1  PROCEDURE  UNSPLITBUF; 

fll       JJ  3:d      1  (♦  STICH  THE  BUFFER  BACK  TOGETHER  AGAIN.  *) 

658   12  3:o      0  BEGIN 

tin       J?  V.l               °    M0VELEFT(EBUF-CTHEREST3,EBUF-CCURS0RD,LM0VE); 

n?  li  f-1  13    READJUST(LEFTPART+1,CURS0R-(LEFTPART+1)); 

l°^t       12  3.1  28    BUFC0Unt:=BUFC0UNT  +  CURS0R-(LEFTPART  +  1); 

663   il  sij  11    ^^^^f^SORlzLEFTPART  +  l;  (♦  CURSOR  POINTS  TO  THE  BEGINNING  OF  THE  FILE  *) 

66i+   12  3:o  58 

665  12  H:d      1  PROCEDURE  READERR; 

666  12  tf:o      0  BEGIN 

Itl      Jo  aiJ  J         ERRORC 'MARKER  EXCEEDS  FILE  BOUNDS. • .NONFATAL) 5 

668  12  ^:l  zn       unsplitbuff; 

669  12  tf:i  36    CENTERCURSOR(TRASH»MlDDLE,TRUE)  ! 

670  12  mi  46    EXIT(COPYFILE) 

671  12  «f:o  50  end; 

672  12  tf:o  62 

673  12  5:d      1  PROCEDURE  SPLITBUF; 

675   J|  =:°      J  <*  !^iJ  THE  BUFFER  AT  THE  CURSOR.   THEREST  POINTS  TO  THE  RIGHT  PART,  LMOVE 

67^   ll  l-n  J     ILII^   S^"®^"  °^  ^"^  '^^^"■^  P'^'^"^'  LEFTPART  POINTS  TO  THE  END  OF  THE  'LEFT 

;,,  ii  ^'°  ^           PART',  and  cursor  remains  UNCHANGED.  *) 

677  12  5:o  0  BEGIN 

678  12  5:i  0   therest:=bufsize-(bufcount-cursor); 

679  12  5:i  a   lmove:=bufcount-cursor+i; 
ffO  12  5:i  16   leftpart:=cursor-i; 

III      ll  l:^  22    M0VERIgHT(EBUF-CCURS0RD,EBUF-CTHEREST3, LMOVE) 

682  12  5:o  35  END? 

683  12  5:o  H8 

68f  12  6:d  1  procedure  parsefn; 

685  12  6:o  1  vAR  I ,lptr.rptr,comma:  integer; 

686  12  6:d  5      MARK:  STRING; 

687  12  6:o  0  BEGIN 

688  12  6:i  0    LPTr:=poS(»C»,FN); 

689  12  6:i  15    IF  LPTr=0  THEN 

690  12  6:2  20      BEGIN  (*  WHOLE  FILE  *) 

691  12  6:3  20        STaRTMARK:='          •; 

692  12  6:3  37        ST0PMARK:=  •         » 

693  12  6:2  41      END 

139 


591+ 

12 

6:i 

5t 

695 

12 

6:2 

56 

696 

12 

6:3 
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12 

6:3 

71 
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12 

6:3 

91 

699 

12 

6:3 

14 

700 

12 

6:3 

35 

701 

12 

6:3 

48 

702 

12 

6:3 

55 

703 

12 

613 

63 

701 

12 

613 

32 

705 

12 

6:3 

03 

706 

12 

6:3 

22 

707 

12 

6:2 

39 

708 

12 

6:1 

39 

709 

12 

6:1 

75 

710 

12 

6:1 

11 

711 

12 

6:1 

52 

712 

12 

6:1 

78 

713 

12 

6:2 

03 

714 

12 

6:1 

38 

715 

12 

6:0 

67 

716 

12 

6:0 

88 

717 

12 

7:d 

1 

718 

12 

7:d 

3 

719 

12 

7:d 

3 

720 

12 

7:d 

3 

721 

12 

7;o 

0 

722 

12 

7:1 

0 

723 

12 

7:2 

5 

72t 

12 

7:3 

5 

725 

12 

7:3 

12 

726 

12 

7:n 

25 

727 

12 

7:5 

25 

728 

12 

7;5 

48 

729 

12 

7:5 

50 

730 

12 

7:5 

60 

731 

12 

7:4 

64 

732 

12 

7:3 

64 

733 

12 

7:4 

66 

734 

12 

7:5 

66 

MO 

ELSE 

BEGIiM 

rptr:=pos( • J'»FN) ; 

IF  (RPTR=0)  OR  (RPTR<LPTR)  OR  ( RPTR<>LENGTH( FN ) )  THEN  ERRMARKER; 

MARK:=COPY(FNtLPTR+l»RPTR-LPTR-l) ;  {*  STUFF  BETWEEN  THE  BRACKETS  *) 

FN:=COPY(FNtl,LPTR-l) ; 

COiw|MA:=POS{  'tSMARK)  ; 

IF  COMMA=0  THEN  ERRMARKER; 

I:=LENGTH(MARK)-C0MMA5  (♦  SECOND  MARKER  PTR  ♦) 

MOVELEFT(MARKC:i3»STARTMARK,MIN(8iCOMMA-l)  )  ; 

FILLCHAR(STARTMARKCCOMMA-1D,MAX(0»8-(COMMA-1) ) ,»  ») ; 

M0VELEFT(MARKCC0MMA+1:.ST0PMARK»MIN{I«8)); 

FlLLCHAR(STOPMARKCnfMAX(0«8-I).»  •) 
ENDI 
FOR  i:=o  TO  7  DO  STARTMARKC I 3:=UCLC ( STARTMARKC I D) ; 
FOR  i:=0  TO  7  DO  STOPMARK  CI 3:=UCLC (STOPMARKC 13) ; 
FOR  l:=l  TO  LENGTH(FN)  DO  FNCI 3I=UCLC(FNCI D) ; 
IF  ((P0S(*.TEXT»»FN)<>LENGTH(FN)-4)  OR 

(LENGTH(FN)<=4))  and  <FNCLENGTH(FN>3<>«,M  THEN 

fn:=concat{FNi».text»)» 
if  fnclength(fn)3a».»  then  delete{fntlength(fn) .1 ) ; 
end; 

PROCEDURE  stuffit(start.stop:integer) ; 

(*  PUT  THE  contents  OF  BUFR  INTO  EBUF.   OVFLW  IS  SET  TO  TRUE  WHEN  THERE  IS 

NO  MORE  ROOM  IN  THE  BUFFER.  ♦) 
VAR  amount:  INTEGER; 
BEGIN 

IF  START<=ST0P  THEN 
BEGIN 

AMOUNT :=ST0P-START+i; 

IF  CURSOR+AMOUNT+250(*SLOP*)>=THEREST  THEN 
BEGIN 

error( 'buffer  overflow, • .nonfatal) ; 

unsplitbuff; 

centercursor( trash f middle* true) ; 

exit(copyfile) 

END 
ELSE 
3EGIN 

MOVELEFTCBUFRC START D.EBUF^C CURSOR D. AMOUNT) ; 


Ill     ,?  I:  ^  cursor:=cursor+amount 

737  12  7:2  31  END 

738  12  7:0  81  end; 

739  12  7:0  94 

IVi  ]i  ®*°  ^  PROCEDURE  getmext; 

7'+l  12  8:0  0  BEGIN 

7J3  12  l\\  27  °°5J^  =  =S'-JCKREAD(F,BUFR,2,PAGE+PAGE)<>2, 

7^5  \l  Vli  56  ^[s?°Jo?Ni^^^^ 

Vlt  J2  8:i  69  PA6E:=PAeE+ll' 

7<t7  12  8:0  77  end; 

7't6  12  8:0  90 

«!  J?  ^'^  ^  PROCEDURE  CHKOVFLW; 

750  12  9:0  0  BEGIN 

752  \l  IW  1?  IPg^STOPOFFSET>=NOTNULLS)  AND  { STOPPAGE<PASE)  THEN 

III  \l  IW  \l  STOPPABE:=STOPPA(IC*it 

755  \l  q.i  II  c  ST0P0FFSET:=ST0POrFSET.NOTNULLS; 
'33  It  9,2  35  END? 

756  12  910  35  ENDJ 

757  12  9:0  <f8 

tiS  Jd  \Vil  ^  PROCEDURE  FINOMARKCRSt 

760  12  ";S  \  i^R^^^"  STARTNARK  AND  STOPMARK  FIND  OUT  THEIR  PAGE  NUMBERS  AND  OFFSETS  *) 

III  Jf  W^  ^  P^=  HEADER! 

762  12  10:d  13 

76?  \l  \\\l  8  VAR^^°^''^  SEARCH(MNAHE:nAME;VAR  OFF.PNUM:  INTEGER); 

HI  Jf  \V^  ^  ^-  INTEGER; 

766  12  11:0  0  BEGIN 

767  12  U:i  0  l;=0| 

769  \\  \V'\  ^l  rS^b^  (I<P2. COUNT)  AND  (MNAMEOPZ.NAMECI])  DO  l:  =  ini 
77n  to  Jt.'I  ^  ^f^  MNAMEOPZ.NAMECn  THEN                   u  x.  1  ii 

770  12  11:2  '♦7  BEGIN 

772  12  W'A  tI  ERRORCMARKER  NOT  THERE,  •  .NONFATAL)  ; 

77?  io  ,,  ^^  UNSPLITBUFF; 

774  12  iV'l  77  EXIT(COPYFILE) 
''^  12  11.2  77  ENO; 

775  12  11:1  77  0FF:=p2.P0FFSETCn; 
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Jt  '±d 

776  12  11:1  86  PNUV1:=PZ.PAGENCI:; 

777  12  11:1  93  IF  PnU''^  =  0  THCf^ 

778  12  11:2  99  BESIN  0FF:=0FF-1;  PNUM:=1  END;  (*  KLUDGE  TO  MAINTAIN  COMPATIBILITY  *) 

779  12  11:0  08  END; 

780  12  11:0  22 

761  12  10:0  0  begin(*  fjndmarkers  *) 

782  12  10:1  0  startpage:=i;    startoffset:=o;   (*  default  values  *) 

783  12  10:1  8  ST0PPAge:=32767;  STOPOFFSET :=32767 5 

TSt  12  10:1  20  IF  (STaRTMARKO*         M  OR  (STOPMARkO*         •)  THEN 

785  12  10:2  59  BEGIN 

786  12  10:3  59  IF  BL0CKREAD{F,P^»2 , 0 ) <>2  THEN  READERR; 

787  12  10:3  80  IF  STARTMARK<>»  ♦  THEN  SEARCH( STARTMARK , STARTOFFSET.STARTPAGE) 5 
768  12  10:3  12  IF  ST0PMARK<>»         »  THEN  SEARCH( STOPMARKt STOPOFFSET iSTOPPAGE) 

789  12  10;2  "+2  END 

790  12  10:0  '+'+  end; 

791  12  10:0  56 

792  12  110  0  BEGIN 

793  12  1:1  0  PROMPTliNE:=»  copy:  FROM  WHAT  FILECMARkER»MARKER3?  •; 
791  12  i:i  59  REPEAT 

795  12  1:2  59  prompt; 

796  12  1:2  62  READln<FN); 

797  12  1:2  78  IF  LENGTH(FN)=0  THEN  EXIT ( COPYFILE) ; 

798  12  1:2  91  PARSEFN; 

799  12  1:2  93  RESET(FtFN); 

800  12  1:2  0*1  PR0MPtLINE:  =  »  copy:  file  not  present,  FILENAME?  »; 

801  12  i;i  17  until  ioREsult=o; 

802  12  1:1  53  PR0MPTLINE:=»  COPY*;  PROMPT; 

803  12  1:1  69  splitbuf5 

801  12  1:1  71  findmarkers; 

805  12  1:1  73  page:=startpage; 

806  12  1:1  76  GETNEXT; 

807  12  1:1  78  WHILE  ( STARTOFFSET>=NOTNULLS)  AND  NOT  DONE  DO 

808  12  1:2  86  BEGIN 

809  12  1:3  86  chkovflw; 

810  12  1:3  88  startoffset:=startoffset-notnulls; 

811  12  1:3  93  GEtnEXT; 

812  12  1:2  95  end; 

813  12  1:1  97  IF  {ST0PPAGE<PAGE)  AND  ( STOp0FFSET<N0TNULLS)  THEN 
811  12  1:2  06  STUFFlT(STARTOFFSET,MlN(NOTNULLS-liSTOPOFFSET-l) ) 

815  12  1:1  18  ELSE 

816  12  1:2  22  STUFFIT(START0FFSET»N0TNULLS-1) ; 


Ill  \l  \\\  l\  W'^I'-E  {(STOPPAGE>  =  PAGE)  OR  { STOPOFFSET>=NOTNULLS )  )  AND  NOT  DONE  DO 

319  12  1:3  40  CHKOVFLW; 

^20  12  1:3  42  getnext; 

fpi  J^  J:J  ^^  IF  (STOPPAGE<PAGE)  AND  (STOPOFFSEKNOTNULLS)  THEN 

«5?  J,  J:^  Jf  STUFFIT(0,MIN(NOTNULLS-1,STOPOFFSET-1)) 

o<i5  12  1:3  65  ELSE 

3TUFFIT(O.NOTNULLS-1) 


824  12  1:4  69 

825  12  1:2  73  end; 

827  W  \\\  V,  .^.L^°'^^^^^^<>°  ^^^"^    ERRORCDISK  ERROR.  •  ^NONFATAL)  ; 

°'^'  1<^  1»1  01  unsplitbuf; 

fjf  12  i:i  03  CENTERCURS0R(TRASH, MIDDLE, TRUE); 

629  12  i;i  13  CLOSE(F); 

830  12  1:0  20  end; 

831  12  1:0  46 

832  12  1:0  46  (*$I  COPYFILE   *) 
832  12  1:0  46  (*$I  ENVIRON    *) 

S^p  Jf  I'D  1  SEGMENT  PROCEDURE  ENVIRONMENT; 

834  13  1:d  1  VAR 

835  13  1:d  1  i:  INTEGER; 

836  13  1:d  2 

837  13  2:d  1  PROCEDURE  ERASEIO; 

838  13  2:d  I  VAR  I:  INTEGER; 

839  13  2:0  0  BEGIN 

8|;0  13  2:1  0  WRITEC  MIO); 

flaJ  \\  \\\  J  '"OR  i:=l  TO  10  DO  WRITE(CHR(BS) )  I 

842  13  2:0  36  END; 

8f3  13  2:0  50 

!'*i  13  3:d  1  PROCEDURE  bool{b:boolean)  ; 

845  13  3:0  0  BEGIN 

847  J3  ?iJ  xS  }I    I    ^^^^    WRITE(.TRUE.)  ELSE  WRITE ( ♦FALSE* ) » 

o*»'  13  5,1  34  writeln 

8^8  13  3;o  34  END; 

8*f9  13  3:0  52 

850  13  4:d  3  FUNCTION  GETBOOL:  BOOLEAN; 

851  13  4:d  3  VAR  CH:  CHAR; 

852  13  4:0  0  BEGIN 

?^?  W  "^'^  °  ERASEio;  ch:=uclc(Setch); 

!^^  \\  ^'1  l**  WHILE  NOT  (CH  IN  C'TS'F'D)  DO 

855  13  4:2  35  BEGIN 

856  13  4:3  35  WRITE(»T  OR  F'); 
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857  13  4:3  51  FOR  TRASH:=0  TO  5  DO  WRITE( CHR (BS ) ) ; 

Q58  13  4:3  85  ch:=uclc(GETch) 

859  13  4:2  90  EHj; 

860  13  f:i  99  IF  Crl=*T'  THEN 

861  13  4:2  04  BEGIN 

862  13  4:3  04  WRITECTRUE   •); 

863  13  4:3  20  GETB00L:=TRUE 

864  13  4:2  20  END 

865  13  4:1  23  ELSE 

866  13  4:2  25  BEGIN 

867  13  4:3  25  WRITE( ♦FALSE  •); 

868  13  4:3  41  GETB00L:=FALSE 

869  13  4:2  41  end; 

870  13  4:0  44  END? 

871  13  4:0  60 

872  13  5:d  3  FUNCTION  GETINT:  INTEGER? 

873  13  5:d  3  VAR 

874  13  5:d  3  CH:CHAR5 

875  13  520  4  N:  INTEGER? 

876  13  510  0  BEGIN 

877  13  5:1  0  ERASElO; 

878  13  5;i  2  N:=0; 

879  13  5:1  5  REPEAT 

880  13  5:2  5  REPEAT 

881  13  5:3  5  ch:=6Etch; 

882  13  5:3  12  IF  NOT  (CH  IN  C » 0 • . . 'S' f CHR< SP» fCHRCCR) 3) 

883  13  5:3  31  THEN  WRITE( ♦#» »CHR (BELL) tCHR<BS) ) I 

884  13  5;2  60  UNTIL  CH  IN  C '0 • • . 'g* .CHR(SP) »CHR(CR) 3; 

885  13  5:2  81  IF  CH  IN  C'0»,,»9»3  THEN 

886  13  523  96  BEGIN 

887  13  5:4  96  WRITE(CH); 

888  13  5:4  04  IF  N<1000  THEN  n:=N*10+ORD(CH)-ORD< ♦ 0 ♦ ) 

889  13  5:3  17  END? 

890  13  5:1  20  UNTIL  CH  IN  CCHR{SP) »CHR (CR) D? 

891  13  5;i  29  GETInt:=N?  WRITE{»   •) 

892  13  5;0  44  END? 

893  13  5:0  60 

894  13  1:0  0  BEGIN 

895  13  1:1  0  WITH  PaGEZERO  DO 

896  13  1:2  0  BEGIN 

897  13  1:3  0  CLEARSCREEN; 
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83 

p^omptline:=  •  environment:  coptionsd  <etx>  or  <sp>  to  leave. 
PRO'^PT!  needpromft:=true;  ^  rp  iu  llavl 

WRITELN! 


A(UTO    INDENT 
FdLLING 
L(EFT    MARGIN 
RdGHT    MARGIN 
P(ARA    MARGIN 
C{OMNlAND    CH 
T(OKEN    DEF 


•,BUFCOUNT,»  BYTES  USED,  • , BUFSIZE-BUFCOUNT+l ♦ •  AVAILABLE.*) 


OR  TDEFINED  THEN 


WRITE( 
WRITE( 
WRITE{ 
WRITE( 
WRITE( 
WRITE( 
WRITE( 
WRITELN; 
WRITELN( ' 
WRITELN; 
IF  SDEFINED 
3EGIN 

WRITELNC    patterns:'); 

IF  TDEFINED  THEN  WRITE(» 
IF  SDEFINED  THEN  WRITEC, 
WRITELN;  WRITELN; 
END; 
IF  COUNT>0  THEN  WRITELN(» 
WRITEC   •); 
FOR  l:=0  TO  COUNT-l  00 

BEGIN  WRITE{t  »:6,NAMECID); 

IF  (1+4)  MOD  3=0  THEN  BEGIN 
END; 
WRITELN; 
WRITELN; 
WRITELN{»     DATE  CREATED: 


BOOL{AUTOINDENT) ; 
B00L(FILLIN6) ; 

WRITELN(LMARGIN) ; 
WRITELN(RMARGIN) ; 
WRITELN(PARAMARGIN) f 
WRITELN(RUNOFFCH) ; 
BOOL(TOKDEF) ; 


<SUBST>= 


markers: •) 


<TARGET>=  • • • ,target:tlength, '♦»•); 


» 1 1 


«substring;slength^ 


f  ♦  f  f 


); 


WRITELN;  WRITEC   »)  END 


♦t CREATED. MONTH, •-», CREATED. DAY, »-', 
CREATED. year,*    LAST  USED?  •» 

LASTUSED. MONTH, •-• ,LASTUSED. DAY, ♦-• . 

LASTUSED.YEAR) ; 
GOTOXY(LENGTH(PROMPTLINE) ,0) ; 
REPEAT 

ch:=uclc{6Etch) ; 

IF  NOT  (CH  IN  i:'A«,'C','FS»L»,'P«.»R»,'T»,»  •  .CHR  (ETX  )  .CHRirR  ni 
BEGIN  ERRORCNOT  OPTION* , NONFATAL) ;  PROMPT;  ^^HR (ETX ) ,CHR(CR) D) 

CASE  CH  OF 

Ir!*  nlf^^    G0T0XY(18,1);  AUT0INDENT:=GETB00L  END; 
•F':  BEGIN  G0T0XY(18,2);  FILLING:=GETB00L  END; 


THEN 


19^5 


1  ^O 


959  13  1:5  97                                  'L*:     i3E3lN    bOTOXY  ( 18 » 3 ) 

9'*0  13  1:5  1    11                                   ♦R':     3E&irvi    ti0T0XY(18»'+) 

^^1  13  1:5  1  25             'P':  BEGIN  bOTOXY ( 18 , 5 ) 

912  13  i:b  1  39             'C:  5EGIN  (30T0XY  ( 18  ♦  6 ) 

943  13  1:5  1  5b             'T':  3EGIN  e0T0XY(l8t7) 

94(+  13  1:5  1  67            end; 

9'+5  13  1:1  1  16          GOTOXY(LE^^IGTH<^'ROMPTLI^IE),0); 

9<+6  13  1:3  1  25        UNTIL  CH  IN  C  •  •  1 CHR  ( ETX )  f  CHR  { CR )  3 

9f7  13  1:3  1  47        redisplay; 

948  13  1:2  1  50  end; 

949  13  1:0  1  50  end; 

950  13  1:0  1  72 

951  13  1:0  1  72 

952  13  i:o  1  72 

953  13  i:a  1  72  (*$I  ENVIRON    *) 

953  13  1:0  1  72  (*$I  PUTsyNTAX  *) 

954  14  1:d  1  SEGMENT  PROCEDURE  PUTSYNTAX; 

955  14  1:D  1  VAR 

956  14  1:d  1    DO. Dlf02«BLK»PTR. COLON:  INTEGER; 

957  14  1:d  7    T,C:PACKED  array  C0.»23  OF  CHAR; 

958  14  i:d  11   buf:packed  array  CO. .10233  OF  char; 

959  14  i:d  23   f:  FILE; 

960  14  1:D  63 

961  14  2:d  1  PROCEDURE  PUTNUM; 

962  14  2:0  0  BEGIN 

963  14  2:1  0    MSG:='SYNTAX  ERROR  #•;  PUTMSG; 

964  14  2:1  25    WRITE{USERINFO.ERRNUM»»,  TYPE  <SP>» ) 5 

965  14  2:0  56  end; 

966  14  2:0  68 

967  14  i:o  0  BEGIN  (♦  pUTSYNTAX  *) 

968  14  1:1  0    WITH  USERINFO  DO 

969  14  1:2  13  BEGIN 

970  14  1:3  13  0PEN0LD(F» •♦SYSTEM. SYNTAX» ) ; 

971  14  1:3  38  IF  lORESULTOO  THEN  PUTNUM 

972  14  1:3  44  ELSE 

973  14  1:4  48  BEGIN 

974  14  1:5  48  IF  ERRNUM<=104  THEN  BLK:=2 

975  14  1:5  55  ELSE 

976  14  1:6  60  IF  ERRNUM<=126  THEN  BLK:=4 

977  14  1:6  67  ELSE 

978  14  1:7  72  IF  ERRNUM<=151  THEN  BLK:=6 


lmargin:=getint  end; 
rmargin:=getint  end; 
paramargin:=getint  end; 
read(runoffch)  end; 
tokdef:=getbool  end 
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39 
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55 
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14 
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62 
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14 
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73 
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14 

1:7 

80 
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14 

1:7 

94 

993 

14 

1:7 

01 

99tt 

14 

1:8 

01 

995 

14 

1:8 

08 

996 

14 

1:8 

21 

997 

14 

1:8 

32 

998 

14 

1:8 

37 

999 

14 

1:7 

50 

1000 

14 

1:7 

70 

1001 

14 

1:7 

66 

1002 

14 

1:8 

90 

1003 

14 

1:9 

90 

1004 

14 

1:9 

06 

1005 

14 

1:9 

22 

1006 

14 

1:8 

61 

1007 

14 

1:6 

61 

1008 

14 

1:4 

61 

1009 

14 

1:3 

61 

1010 

14 

1:3 

64 

1011 

14 

1:3 

73 

1012 

14 

1:2 

85 

1013 

14 

1:0 

85 

1014 

14 

1:0 

12 

1015 

14 

1:0 

12 

1016 

14 

1:0 

12 
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14 

1:0 

12 

1017 

15 

i;d 

1 

1018 

15 

i:d 

1 

ELSu 

IF  ERRNUM<=185  THEN  BLK:=6 
ELSE 
IF  ERHNUM<=302  THEN  BLK:=10 
ELSE  BLK:=12; 
IF  BL0CKREAD(F,aUF»2.3LK)<>2  THEN  PUTNUM 
ELSE 
BEGIN 

IF  BUFi;OJ=CHR(DLE)  THEN  PTR:=2  ELSE  PTR:=0; 

D0;=ERRNUM  DIV  100;  (*  CONVERT  ERROR  NUMBER  TO  CHARACTERS  *) 

Di;=(ERRNUM-D0*100)  DIV  10; 

d2:=errnum  mod  10; 

tcod:=chr(do+ord('om);  tcid:=chr(di+ord(»om); 

TC2:;=cHR{D2+ORD('0M  )  ; 
REPEAT 

fillchar(c.3«»0m; 
cqlon:=scan(maxchar,  =  »:sbufcptR3)  ; 
moveleft{bufcptr3,cc3-colon3,colon); 
colon:=colon+ptr; 

PTR:=SCAN(MAXCHAR,=CHR(E0L)»BUFCPTRD}+PTR+3 
UNTIL  (T=C)  or  {B'JFCPTR3=CHR{0)); 
IF  (TOC)  and  (BUFCPTR3=CHR(0))  THEN  PUTNUM 
ELSE 

BEGIN 

MOVELEFT(BUFCCOLON+13»MSGC13t  (PTR-C0L0N)-*f ) ; 
MSGC0D:=CHR(MIN(68f(PTR-COLON)-4))|  (»  R-  REQUIRED  *) 
home;  CLEARLINE(O);  WRITE(MSGi».   TYPE  <SP>»)J 
END 
END 
END(*  IF  lORESULTOO  *)  ; 

showcursor; 

repeat  until  getch='  •; 

errblk:=o;  errsym:=o;  errnum:=o;  {♦  only  yell  once!!!  *) 
end(*  with  userinfo  *) 
end(*  putsyntax  *); 

(*$I  putsyntax  *) 

(*$I  COMMAND    ♦) 

SEGMENT  PROCEDURE  EDITCORE; 
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83 

1041 
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4:2 

88 
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29 
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1  4S 

(*  CORE  PROCEDURES.   EXECUTE  THESE  COMMANDS  UNTIL  EITHER  A  SET  ENVIRONMrNT 
COMES  ALONG  OR  A  QUIT  COMMAND.  *)  LNVIKONMENT 


PROCEDURE  NEXTCOMMAND;  FORWARD! 
PROCEDURE  FIXDIRECTION; 

3e:gin 

IF    COMviAND=FORkJAROC    THEN    DIRECTI0N:  =  '>»    ELSE    DIRECTI0N:  =  »<»  ; 

home;  ^rite(direction);  (♦  update  prompt  line  *) 
showcursor;  nextcommand 
end; 

procedure  copy; 

BEGIN 

promptline:=»  copy:  bcuffer  fcrom  file  <esc>'; 

PROMPT;  needprompt:=true; 

repeat 

ch:=uclc(getch); 

until  CH  in  C'B'f •f»»CHR(ESC)D; 
IF  CH=»B'  then 

begin 

IF  NOT  COPYOK  qR  ( (SUFCOUNT+COPYLENGTH+10>CQPYSTART) 

AND  (C0PYSTART>=BUFC0UNT)) 
THEN  ERR0R(»INVALID  COPY. • .NONFATAL) 

ELSE 

IF  BUFCOUNT+COPYLENGTH>=BUFSIZE  THEN  ERRORCNO  ROOM' , NONFATAL ) 

l^  ^  o  u. 

BEGIN 

IF  COPYLINE  THEN 
BEGIN 

getleading; 
cursor:=linestart 

END; 

??^^ro2vI!A!Tr^P.=  S^°'^^'^^^'''''^'^^^^°'^*"PY'-ENGTHa.BUFC0UNT-CURS0R  +  l)j 
IF  (C0PYSTART>=CURS0R)  AND  (C0PYSTART<BUFC0UNT)  THEN 

moveleftcebuf-ccopystart+copylengthd.ebuf-ccursorj.copylength) 

L.  Lb  O  Cw 

M0VELEFT(EBUF-CC0PYSTART3,EBUF'^CCURS0R3,C0PYLENGTH); 
BUFC0Unt:=BUFC0UNT+C0PYLENGTH;  .uuriuuMtom; , 


1060  13  4:6     63  READ JUST ( CURSOR , COPYLENGTH ) ; 

1061  15  4:6     46  GlTLEADING; 

1062  15  4:6     49  CURSOR ; =MAX ( CURSOR t STUFFSTaRT ) ; 
10to3  15  4:6     58  CENTERCUKS0R(TRASH,MI00LE»TRUE) 

1064  15  4:5  65  ENDS 

1065  15  4:2  68      ErgD  (*  CH=«B'  *) 

1066  15  4:i  68    ELSE 

1067  15  4:2  70      IF  CH='F«  THEN  EXIT ( EDiTCQRE ) ; 
1066  15  4:1  79    SHOWCURSOR; 

1069  15  4:1  82    NEXTCOmmANO; 

1070  15  4:0  84  END(*C0PY*); 

1071  15  4:0  02 

1072  15  5:d      1  PROCEDURE  DUMP; 

1073  15  5:0      0  BEGIN 

1074  15  5:1      0    NEXTCOviMANO; 

1075  15  5:0      2  END(*  DUMP  *); 

1076  15  5:0  14 

1077  15  6:d      1  PROCEDURE  FIND;  FORWARD; 

1078  15  6:d      1 

1079  15  7:d      1  PROCEDURE  INSERTIT;  FORWARD; 

1080  15  7:d     1 

1081  15  8:d      1  PROCEDURE  JUMP; 

1082  15  8:d      1  VAR  CH:  CHAR; 

1083  15  8:d      2 

1084  15  9:d      1  PROCEDURE  JUMPMARKER; 

1085  15  9:d      1  VAR 

1086  15  9:d      1    l:  INTEGER; 

1087  15  9:d      2    MNAME:  packed  ARRAY  CO. .73  OF  CHAR; 

1088  15  9:0      0  BEGIN 

1039  15  9:1      0    WITH  PagEZERO  DO 

1090  15  9:2      0      BEGIN 

1091  15  9:3      0        GETNAME( »JUMP  TO*. MNAME); 

1092  15  9:3  15        IF  mNAMEO'         »  THEN 

1093  15  9:4  33  BEGIN 

1094  15  9:5  33         i:=o; 

1095  15  9:5  36  WHILE  (KCOUNT)  AND  ( MNAMEONAMEC 1 3)  DO  I:  =  I  +  1; 

1096  15  9:5  62  IF  MNAMEONAMECI3  THEN 

1097  15  9:6  75  ERRORCNOT  THERE.  •»  NONFATAL) 

1098  15  9:5  89  ELSE 

1099  15  9:6  94  BEGIN 

1100  15  9:7  94  CURS0R:=P0FFSETCI3; 
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150 

1101  15  9:7  03  GETLEADIMG; 

1102  15  9:7  06  CURSOR:=MAX{CURSOR«STUFFSTART) ; 

1103  15  9:7  15  CENTERCURSORdRASHtMlDOLE, FALSE) 

iiof  15  9:6  22  end; 

1105  15  9:^  25  END5 

1106  15  9:2  25  end; 

1107  15  9:0  25  end;  (*  JUMPMARKER  ♦) 

1108  15  9:0  10 

1109  15  8:0  0  BEGIN  (*  JUMP  *) 

1110  15  8:1  0  promptline:='  jump:  BCEGINNINS  E(ND  mcarker  <ESC>»; 

1111  15  8:1  11  PROMPT! 

1112  15  8:1  17  needprompt:=true5  (*  need  to  redisplay  edit:  PROMPTLINE!  *) 

1113  15  8:1  51  repeat 

1111  15  8:2  51  CH:=UCLC(GETCH); 

1115  15  8:2  63  IF  CH=*B»  THEN 

1116  15  8:3  68  BEGIN 

1117  15  8:1  68  cursor:=i; 

1118  15  8:1  71  getleading; 

1119  15  8:1  71  cursor:=stuffstart; 

1120  15  8:1  77  CENTERCURS0R(TRASH»1»FALSE) 

1121  15  8:3  82  END 

1122  15  8:2  85  ELSE 

1123  15  8:3  87  IF  CH='E»  THEN 
1121  15  8:1  92  BEGIN 

1125  15  8:5  92  CURS0R:=BUfC0UNT-1? 

1126  15  8:5  97  CENTERCURSOR^TRASHfSCREENHEIGHT-liFALSE); 

1127  15  8:1  07  END 

1128  15  8:3  07  ELSE 

1129  15  8:1  09  IF  CHs'M*  THEN  JUMPMARKER 

1130  15  8:1  11  ELSE  IF  CH<>CHR{ESC)  THEN  ERRWAIT; 

1131  15  8:i  28  UNTIL  (CH  IN  C 'B » t •£* t »«♦ f CHR (ESC) 3) ; 

1132  15  8:1  51  nextcommand; 

1133  15  8:0  53  end; 
1131  15  8:0  68 

1135  15  10:d  1  PROCEDURE  DEFMACRO; 

1136  15  10:0  0  BEGIN 

1137  15  10:1  0  WITH  PAGEZERO  DO  IF  FILLING  AND  NOT  AUTOINDENT  THEN 

1138  15  10:3  10  BEGIN 

1139  15  10:1  10  BLANKCRT(l); 

1110  15  10:1  11  THEFIXER(CURSOR.REPEATFACTOR.TRUE) i 

1111  15  10:1  20  CENTERCURSORCTRASHtMlDDLE.TRUE); 


li;+2   15    10:3  30      END 

li:i      11         III]  ^«    SHolcukfoH-'^' 

1147   1^  iS'^  ^^    l^£XTCO^.MAND; 

iJs^  J=  .^^-^      ^  VAR 

li?3  15  iii?      '    ^'SLOT:  integer; 

1154  15  lu'o  0  BEGIn"^'  "'""'^  ''"'^  "^^--^^  O"^  CHAR, 

1158  15  n.'l  a      needprompt:=true; 

1159  15  11.3  ifi        C0unT:=MIN(10. COUNT); 

1160  15  ii;J  It       '%r'Gir='° '""' 

1161  15  11»>=,  ox  BEGIN 

""  »  lilt  r,  ^!;f^';?"'i'v 


1163   15    11:6     II  ^^^    1*=0  TO  COUNT-1  DO 

116'+  15  ii;5   89       Moo?frSlrl!/J:*!..:.'^'^^^'^i3) 

33 

53 
1169   15    111?     73  SLOT:=ORD(cH)-ORD{»0') 


ilbt  15  1115  89                "..-..  v.w..»  i  t  /  •  »iMHi«ic.Li  JJ  ; 

lltl  11  11:1  »  pS?ii;r?!:^^3,^^^?-       "HICHO^ETOPEPUCE.., 

H67  15  11:5  53  "NTERCURS0R(TRASH.MI00L£:,TRUE)1 

1168  15  11:5  ;i  lfJ!°''Ai"   1"   ■:'0-..>9>3)    THEN   GOTO   1; 


1170  U  lul  V.  ,Jf 

7^  II  11:1  It  slot:=count, 

1173  15  llll  II  SETNAMECSETSmNAME)! 

117.  ll  III'  It  ''  'G?r"         •  "" 

1175  15  11:5  1?  ^S« 

1176  15  11-6  P7  '^^'^  ^-=0  TO  COUNT-1  DO 

1177  15  11:5  tn  .  ^'^  NAMECI3=MNAME  THEN  SL0T:  =  I 

1178  15  11:5  to  !ll^!!EE!i:?P-"MAME;  ^ 


1179  15  11:5  68         poffsetcslotj:=cursor; 

1180  15  11:h  78 

1181  15  11:2  83      END 

1182  15  11:1  83  i:enD; 


1180  15   ii:h   78        l^   slot=count  then  count;=count+i 

1181   15    11:2     83         ^^ 
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15 
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02 

llQtf 

15 

12:d 

1 
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15 

i2:d 

1 

1186 

15 

12:0 

0 

1187 

15 

12:1 

0 

1188 

15 

12:1 

fO 

1189 

15 

12:1 

f7 

1190 

15 

12:2 

f7 

1191 

15 

12:2 

59 

1192 

15 

12:2 

68 

1193 

15 

12:3 

70 

1194 

15 

12:3 

75 

1195 

15 

12:1 

89 

1196 

15 

12:1 

11 

1197 

15 

1211 

If 

1198 

15 

12:0 

16 

1199 

15 

12:0 

30 

1200 

15 

13:d 

1 

1201 

15 

13:0 

0 

1202 

15 

13:1 

0 

1203 

15 

13:1 

10 

120f 

15 

13:1 

13 

1205 

15 

13:0 

13 

1206 

15 

13:0 

28 

1207 

15 

i«+:d 

1 

1208 

15 

14:d 

1 

1209 

15 

If  :d 

1 

1210 

15 

14:d 

3 

1211 

15 

14:0 

0 

1212 

15 

If  :i 

0 

1213 

15 

If  :i 

68 

1214 

15 

If  :i 

75 

1215 

15 

If  :i 

78 

1216 

15 

If  :i 

81 

1217 

15 

If  :i 

8f 

1218 

15 

If  :2 

8f 

1219 

15 

If  :2 

91 

1220 

15 

if:3 

01 

1221 

15 

If  ;f 

01 

1222 

15 

If:  5 

06 

1223 

15 

If  :6 

06 

■■*   r~  r-\ 

IOC 

PROCEDURE  SETSTUFF; 
VAR  ch:  CHAR; 
BEGIN 

promptline:  =  '  set:  e(nvironme!\jt  m(arker  <esc>»; 

PROMPT;  NEEDPR0MPT:=TRUE? 
REPEAT 

ch:=uclc(getch) ; 

IF    Ch='E»    then    ExIT{EDITCORE) 
ELSE 

IF    CH=«M'    THEN    SLTMARKER 

ELSE    IF    CHOCHrCESC)    THEN    ERRWAIT; 

until  ch  in  c'e'.'m* 'chr(esc)]; 
showcursor; 

NEXTCQwimANO; 
END(*  SETSTUFF  *) J 

PROCEDURE  verify; 
BEGIN 

CENTERCURS0R( TRASH, MIDDLE » TRUE) ; 

SHOWCURSOR; 

NEXTCOMMANO 
END  (*  VERIFY  ♦) ; 

PROCEDURE  XMACRO; 
VAR 

SAVEC.l:  INTEGER; 

save:packed  array  co..maxstringd  of  char; 

BEGIN 

PR0MPTlINE:='  exchange:  text  C<BS>  a  CHAR3  C<ESC>  escapes;  <ETX>  ACCEPTSD'; 

PROMPT;  needprompt:=true; 

showcursor; 

savec:=cursor; 

i:=o; 

repeat 

ch:=geTCh; 

IF  maptocommand(ch)=left  then 

BEGIN 

IF  (cursor>savec)  then 

BEGIN 

i:=i-i;  cursor:=cursor-i;  (♦  decrement  both  ptrs  ») 


1^22?  It  lilt  II                                     EBUF-CCURSORDjrsAVEri:;  (*  RESTORE  BUFFER  *, 

1226  15  ll:5  it  ^^^^^«ITE(CHR(8S),EBUF-[:CURS0RD,CHR(B.S)); 

1227  15  m:3  55        rrjn 

1228  15  I'+ia  55  ELSE 

^230  15  nil  H                     IFJH  =  CHR(E0L)     THEN    BEGIN    ERRWAIT;     SHOWCURSOR    END 

1231  15  m:i+  70 


1232   15  I'.h  91  "'aEGn/''''  ^''  "^  CHR  (  ETX  )  ,  CHR  (  ESC  )  D )  AND  <  EBUF^C  CURSOR  D<>CHR  (  EOL)  )  THEN 

^23^  II  IV'l  ifl  ^^    ^°^  ^^^  ^^    ^'     •..•-•])  THEN  CHlr*-?'; 

1235  15  14-*^  P?  saveci::=ebuf-ccursord; 

1236   15  il'-l  V:  EBUF-CCURSORD:=cH; 

1237  15  il'^l  l\  i:=i+i;  cursor:=cursor+i; 

1238   IS  la^^  ,o  WRITE(CH) 

12'o   15  \l'\  11  l^^^IL  CH  IN  CCHR(ETX),CHR(ESC)3; 

12^1   1^  \l''\  A  ^^    CH=CHR(ESC)  THEN 

i'i'tl   15  m:2  69  BEGIN 

\lll     \l  \l\l  ^^  cursor:=savec; 

12^^       15  14-3  I?  MpVELEFTtSAVECOiI.EBUF-CCURSORO,!); 

1245  15  i^la  11  ^^showcursor;  write(save;i) ;  sho^cursor 

|pa7  il  J"*^  ^^  NEXTCOMr^AND; 

1248   15  14:o  16 

la^n   J^  J^'°  ^  PROCEDURE  2APIT; 

1250   15  15:o  0  BEGIN 

1252  II  ]l\l  I  ^^3^BS(LASTPAT-CURSOR)>80  THEN 

lilt     \l  i'^:^  ®  pRomptline:  = 

1255  II  lilt  II  *  ''''JSpt°'  '''  ''°''  '°  '''  '°'^  ^'^^  ''    '^'^'^    DO  YOU  WISH  TO  ZAP?  (Y/N,'; 

^257  is  IV'l  oo  needprompt:=true; 

I§ln   Js  JL-^  ^^  SHOWCURSOR; 

1261  is  s^  't  NEXTCOMMANi; 

IP^P   is  i=^  ^®  EXIT(ZAPIT) 

1262  15  15:4  22  tnO; 

1263  15  15:2  22  end; 

1264  15  15:1  22  IF  OKT0DEL(MIN{CURsOR,LASTPAT),MAX(CURsOR.LASTPAT))  THEN 

153 
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1265  15  15:2  13      BEGIiM 

1266  15  15:3  ^5                    COPYLINE : =FALSE ! 

1267  15  15:3  47        RE AD JUST ( MIN { CURSOR , LASTPAT ) , -ABS ( CURSOR-LASTPAT ) ) 5 

1268  15  15:3  62        IF  cURSOR>LASTPAT  THEN 

1269  15  15:4  67          MQVElEFT  ( ESUF'tCURSOR  D  i  EBUF'^C  LASTPAT  J^BUFCOUnT-CURSOR  ) 

1270  15  15:3  78        ELSE 

1271  15  15:4  80          ;MOVELEFT(EBUF"CLASTPATD,EBUF'*CCURSOR3,BUFCOUNT-LASTPAT); 

1272  15  15:3  91        BUfcOUNT : =aUFCOUNT-ABS ( CURSOR-LASTPAT) ; 

1273  15  15:3  99       CURSOR : =lastpat ; 

1274  15  15:3  02        CEntERCURSOR ( TRASH i MIDDLE . TRUE ) ; 

1275  15  15:2  12      END; 

1276  15  15:i  12    SHOWCURSOR; 

1277  15  i5:i  15   nextcommand; 

1278  15  i5:o  17  end; 

1279  15  15:o  30 

1280  15  15:o  30  (*$I  COMviaND    *) 
1260  15  15:o  30  (*$I  INSerTIT   *) 

1281  15  7:d      1  PROCEDURE  INSERTIT; 

1282  15  7:d      1  CONST 

1283  15  7:d    1   fudgefactor=io; 

1284  15  7:D      1  VAR 

1285  15  7:d    1   therest,leftpart,savebufcount:  PTRTYPE; 

1286  15  7:D      4    cleared, WARNED, OK, N0TEXTYET«EXITPR0MPT,FIRSTLINE:  BOOLEAN; 
1267  15  7:d  10    SPACES, LMOVE,X, LINE, EOLDIST.RJUST:  INTEGER; 

1288  15  7:D  16    context:  packed  ARRAY  C 0 . .MAXSTRINGD  OF  CHAR; 

1289  15  7:d  80 

1290  15  16:d      1  PROCEDURE  SLAMRIGHT; 

1291  15  16:0      1  (*  MOVE  (SLAM)  THE  PORTION  OF  THE  EBUF'*  TO  THE  RIGHT  OF  (AND  INCLUDING) 

1292  15  16:d      1     THE  CURSOR  SO  THAT  THE  LAST  MUL  IN  THE  FILE  (EBUF'^CBUFCOUNT  D)  IS  NOW  AT 

1293  15  16:d      1     EBUF'^CBUFSIZED.   THEREST  POINTS  TO  THE  BEGINNING  OF  THE  RIGHT- JUSTIFIED 

1294  15  16:d      1     TEXT.  *) 

1295  15  l&:o      0  BEGIN 

1296  15  16:i      0    GETLEADING; 

1297  15  16:i      3    THEREST:=BUFSIZE-(BUFC0UNT-CURS0R) ; 

1298  15  16:i  11   lniove:=bufcount-cursor+i; 

1299  15  16:i  19    M0VERIGHT(E8UF'^CCURS0R],EBUF'^CTHEREST3,LM0VE)  ; 

1300  15  16:i  32    GETLEADING;  (*  SET  BLANKS  *) 

1301  15  16:i  35    IF  THErEST-CURSOR<MAXSTRING  THEN 

1302  15  16:2  44      BEGIN 

1303  15  16:3  44        ERRORCNO  ROOM  TO  INSERT.  •,  NONFATAL)  ; 

1304  15  16:3  69        SHQWCURSORJ 


1305 

15 

16:3 

7? 

1306 

15 

16:3 

74 

1337 

15 

16:2 

73 

1308 

15 

16:2 

7a 

1339 

15 

i6:i 

78 

1310 

15 

i6:o 

98 

1311 

15 

16  :u 

10 

1312 

15 

17:d 

1313 

15 

17  :d 

I3lf 

15 

17:d 

1315 

15 

17:d 

1316 

15 

17  :d 

1317 

15 

17:0 

1318 

15 

17:d 

2 

1319 

15 

i7:o 

0 

1320 

15 

i7:i 

0 

1321 

15 

17:2 

0 

1322 

15 

17:2 

8 

1323 

15 

17:2 

22 

132^ 

15 

17:3 

25 

1325 

15 

17:4 

25 

1326 

15 

17:4 

30 

1327 

15 

17:4 

46 

1328 

15 

17:3 

64 

1329 

15 

I7:i 

64 

1330 

15 

I7:i 

77 

1331 

15 

I7:i 

92 

1332 

15 

I7:i 

03 

1333 

15 

17:2 

03 

1334 

15 

17:3 

19 

1335 

15 

I7:i 

38 

1336 

15 

I7:i 

56 

1337 

15 

i7:i 

59 

1338 

15 

i7:i 

68 

1339 

15 

I7:i 

75 

1310 

15 

17: 1 

89 

13m 

15 

i7:o 

89  1 

131*2 

15 

i7:o 

04 

13'*3 

15 

18:d 

3  1 

134'+ 

15 

18:d 

4 

13<+5 

15 

18:d 

4 

NEXTCOMMAf^O; 
EXlTdNSERTIT) 

end; 
(*  optional  indentation  *) 

EBUF-CTHEREST-2a:=cHR(DLE) ;  EBUF^CTHEREST-l D: =CHR { BLANKS+32 ) ; 
L'^iU  » 

PROCEDURE  WRAPUP; 

(♦  GIVEN  THE  NEW  VALUE  OF  THE  CURSOR  (ONE  PAST  THE  LAST  VALID  CHARACTER 
INSERTED  INTO  THE  BUFFER),  PUT  BACK  TOGETHER  THE  TWO  HA^JeS  Sf  m 

?HrESjTOR'c^';  ll',Vr    ''    ''''    ''''''    '''    ''''''    ^°  'ha%"tS^  JeIt  OF 

vAR  ptr:  ptrtype; 
lngth:  integer; 

BEGIN 

WITH  PAGEZERO  do 

IF  NOTEXTYET  AND  {NOT  FIRSTLINE)  AND 

((NOT  FILLING)  OR  AUTOINDENT)  AND  (CH<>CHR(ESC)) 
THEN  (*  WE  WANT  THE  BLANKS  BEFORE  THEREST  *) 
BEGIN 

3UFcount:=bufcount+2; 
therest:=therest-2;  lmove:=lmove+2; 

^^CURSOR:=SCAN(-MAxCHAR.=CHR(EOL),EBUF-CCURSOR-ia)+CURSOR; 

MOVELEft(EBUF"CTHEREST3,EBUF'^CCURSOR3»LMOVE); 
READJUST(LEFTPART+i,CURS0R-(LEFTPART+1) ) J 

BUFC0Unt:=BUFC0UNT+CURS0R-{LEFTPART+1); 
WITH  PAGEZERO  DO 

IF  FILLING  AND  NqT  AUTOINDENT  AND  (CH=CHR( ETX ) )  THEN 

..Dc.n^^^';'.'^^^''^^^^<^^'^^°'^'^''''^^s^"  firstline:=false;  findxy(X,line)  end; 

UPSCREEN(FIRSTLINE,EXITPR0MPT  or  (CH=CHR(ESC)),LINE);     ^'^^tA.LANEJ  END, 

GETLEAoiNG; 

cursor :=MAX( CURSOR, STUFFSTART ) ; 

lastpat:=leftpart+i; 

Mrvl^o-"^"^^'  copystart:=lastpat;  copylength:=cursor-lastpat; 

iMLXTCOMMAND 

end; 

function  check{value:integer):  boolean; 

**  l^.\:^^  l^   ^"^  potential  value  of  the  cursor,  if  it  is  not  in  legal 
range  then  check  is  false,  this  function  also  warns  the  user  if 


1^ 


a  3 


Id'+o 

15 

18  :o 

iS'+T 

15 

i8:o 

li^B 

15 

i8:i 

13'+9 

15 

ia:i 

1350 

15 

ia:2 

13bl 

15 

13:3 

1352 

15 

18:3 

1353 

15 

18:3 

15514 

15 

18:2 

1355 

15 

13:1 

1356 

15 

18:2 

1357 

15 

18:3 

1358 

15 

18:'+ 

1359 

15 

18:5 

1360 

15 

18:6 

1361 

15 

18:6 

1362 

15 

18:6 

1363 

15 

18:5 

136'+ 

15 

la:** 

1365 

15 

18:5 

1366 

15 

18:6 

1367 

15 

18:6 

1368 

15 

18:6 

1369 

15 

18:5 

1370 

15 

18:3 

1371 

15 

i8:o 

1372 

15 

i8:o 

1373 

15 

19:d 

137<+ 

15 

i9:d 

1375 

15 

19:0 

1376 

15 

19:1 

1377 

15 

19:1 

1378 

15 

19:2 

1379 

15 

19:3 

1380 

15 

19:3 

1381 

15 

19:2 

1382 

15 

19:0 

1383 

15 

i9:o 

138^ 

15 

2o:d 

1385 

15 

2o:d 

1386 

15 

21:0 

153 

4       S/HE  IS  GETTING  TOO  CLOSE  TO  OVERFLOWING  THE  BUFFER  *) 
0  BEGIN 

0  check:=tRUe; 

3  IF    VflLUE<=LEFTPART    THEN 

10  BEGl'xi 

10      ok:=false;  check:=false; 

17  ERRQRCNO  INSERTION  TO  BACK  OVER. ' f NONFATAL > ?  PROMPT; 

53  GOTOXY{X,LINE) 

62  END 

62  ELSE 

64  IF  VALUE>=THEREST-MAXCHAR  THEN 

75  BEGIN 

75  IF  NOT  WARNED  THEN 

81  BEGIN 

81  error( 'please  finish  up  the  insertion* » nonfatal ) ;  prompt; 

21  g0t0xy(x,line) : 

30  warned:=true 

30  END! 

3*+       IF  value>therest-fudgefactor  then 

4  3  BEGIN 

43  ERROR( 'buffer  OVERFLOW  MM* tNONFATAL) ; 

69  WRAPUP; 

71  EXIT(INSERTIT) ; 

75  END 

75  END 

75  end; 

88 

1  PROCEDURE  SPACEOVER; 

1  (*  THIS  PROCEDURE  HANDLES  SPACES  AND  TABS  INSERTED  INTO  THE  BUFFER  *) 
0  BEGIN 

0  IF  CH=CHR{HT)  THEN  SPACES : =8-X+0RD< ODD ( X )  AND  0DD(248))  ELSE  SPACES:=i; 
27    IF  CHECKtCURSOR+SPftCES)  THEN 

38      BEGIN 

38        FlLLCHARCEBUF'^cCURSORD.SPACESt*  *)\ 

47      cursor:=cursor+spaces 

48      END 

54  end; 

66 

1  PROCEDURE  FIXUP;  FORWARD; 
1 

1  PROCEDURE  ENDLINE; 


1337 

15 

2i:d 

1 

1388 

15 

2i:o 

1 

1389 

15 

2i:d 

1 

1390 

15 

21:3 

1 

1391 

15 

2i:c 

0 

1392 

15 

21:1 

0 

1393 

15 

21:2 

0 

1391 

15 

21:3 

0 

1395 

15 

21:3 

7 

1396 

15 

21:3 

12 

1397 

15 

21:3 

17 

1398 

15 

21:1 

22 

1399 

15 

21:5 

27 

l^+OO 

15 

2i:& 

27 

X'+Ol 

15 

2i;6 

30 

ii+oa 

15 

21:7 

38 

lf03 

15 

21:6 

38 

l'fO'+ 

15 

21:5 

45 

I'+OS 

15 

21:4 

50 

mo6 

15 

21:3 

55 

1*^07 

15 

21:4 

66 

I'+oa 

15 

21:5 

66 

1409 

15 

21:5 

75 

I'tlO 

15 

21:4 

78 

1411 

15 

21:3 

82 

1412 

15 

21:2 

86 

1413 

15 

21:0 

86 

1414 

15 

2i:o 

98 

1415 

15 

22:d 

1416 

15 

22:d 

1417 

15 

22:d 

1418 

15 

22. 'D 

1419 

15 

22:d 

1420 

15 

22:d 

1421 

15 

22:0 

0 

1422 

15 

22:1 

0 

1423 

15 

22:2 

5 

1424 

15 

22:1 

18 

1425 

15 

22:2 

20 

1426 

15 

22:2 

25 

1427 

15 

22:3 

46 

(*  FIRST,  IF  THERC  WAS  NO  TEXT  IivlSERTEO  ON  THE  CURRENT  LINE,  THEN  CONVERT 
ALL  OF  THE  SPACES  TO  BLANK  COMPRESSION  CODES.   THEN  INSERT  AN  <EOL>  INTO 
THE  3JFFER  FOLLOinlED  BY  THE  APPROPRIATE  NUMBER  OF  SPACES  FOR  THE 
INDENTATION.  *) 
BEGIN 

WITH  PAGEZERO  do 
BEGIiM 

IF  NOTEXTYET  THEN  FIXUP; 
E3JF*CCURS0RD:=CHR(E0L)  ; 

IF  autoindent  then  getleading 

ELSE 

IF  FILLING  THEN 
BEGIN 

getleading; 

IF  ESUF'^cSTUFFSTART3=CHR(E0L)  then  (*  EMPTY  LINE  *) 

blanks:=paramargin 

ELSE  BLANKS:=LMARGI!\I 
END 

ELSE  blanks:=o; 
IF  check(cursor+blanks+i)  then 

BEGIN 

fillchar(ebuf-ccursor+id, blanks,  •  • ) ; 
cursor :=cursor+blanks+i 

END? 

notextyet:=true; 

end; 
end; 

PROCEDURE  backup; 

(*  IF  the  ch  is  a  backspace  then  decrement  CURSOR  by  1.  if  this  would 

RESULT  in  backing  OVER  AN  <EOL>  OR  A  BLANK  COMPRESSION  CODE,  THEN  FALL 
INTO  THE  CODE  FOR  A  <DEL>  (ALSO  CHANGING  THE  CH  TO  <DEL>  FOR  COMMUNICATION 
TO  THE  OUTER  BLOCK)   ♦) 

VAR  ptr:  ptrtype; 

BEGIN 

IF  CH=CHR{DC1)  THEN 

BEGIN  GETLEADING;  IF  CHECK( LINESTART)  THEN  CURSOR:=LINESTART  END 
ELSE 

IF  (CH=CHR(BS))  AND 

NOT(  (EBUF'^CCURS0R-2D=CHR(DLE>)  OR  (EBUF'^CCURS0R-13=CHR(  EOL)  )  )  THEN 
BEGIN 
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I'^Za  15  22:4  4&  IF  CURS0R<LEFTPART  +  2  THEN  0K:=FALSE  ELSE  CURSOR:  =CURS0R-1 ; 

I'+ag  15  22:3  06  END 

l'+30  15  22:2  66  ELSE 

If+Sl  15  22:3  58  BEGIN  (*  A  <DEL>  OR  EQUIVALENT  *) 

1432  15  22:i+  68  CH :  =CHR  ( DEL )  ;  (*  TELL  THE  CRT  DRIVER  THAT  THE  LINE  HAS  CHANGED  *) 

I'+SS  15  22:'+  73  getleading; 

I'+S^  15  22:4  76  IF  CHECK(LINESTART-I)  THEN  CURSOR :  =LINESTART-1 ; 

1435  15  22:4  90  N0TEXTYET:=FALSE;  (*  THANK  YOU  SHAWN!  *) 

1436  15  22:3  94  END 

1437  15  22:0  94  END; 

1438  15  22:0  06 

1439  15  20:0  1  PROCEDURE  FIXUP; 

1440  15  20:D  1  (*  CONVERT  THE  INDENTATION  SPACES  INTO  BLANK  COMPRESSION  CODES,  AND  MOVE 

1441  15  20:D  1  THE  CURRENT  LINE  AROUND  ACCORDINGLY  *) 

1442  15  20:0  0  BEGIN 

1443  15  20:0  0  (*  FIRST  COMPRESS  THL  CURRENT  LINE  *) 

1444  15  20:1  0  EBUF'*CCURS0R3:=CHR(E0L)  ;  (♦  FOOL  GETLEADING  *) 

1445  15  20:1  5  GETLEADING; 

1446  15  20:1  8  IF  BYTES  >=  2  THEN  (*  OK  TO  PUT  IN  <DLE>  U    AS  IT  STANDS  *) 

1447  15  20:2  13  M0VElEFT(EBUF'*CSTUFFSTART3«EBUF^CLINESTART+23.CURS0R-STUFFSTART) 

1448  15  20:1  26  ELSE 

1449  15  20:2  28  IF  CHECK ( CURS0R+2-BYTES )  THEN 

1450  15  20:3  39  M0VERIGHT(EBUF'^CSTUFFSTaRT3,EBUF'*CSTUFFSTART  +  2-BYTES3.CURS0R-STUFFSTART) 

1451  15  20:2  54  ELSE  BEGIN  0K:=FALSE;  EXIT{FIXUP)  END; 

1452  15  20:1  64  CURS0R:=CURS0R-(BYTES-2) ; 

1453  15  20:1  71  EBUF'^CLINESTARTD:=CHR(DLE);  E3UF''CLINESTART  +  13:=CHR(32+BLANKS)  ; 

1454  15  20:0  35  end; 

1455  15  20:0  98 

1456  15  23:0  1  PROCEDURE  INSERTCH; 

1457  15  23:D  1  (*  THIS  PROCEDURE  INSERTS  A  SINGLE  CHARACTER  INTO  THE  BUFFER.  IT  ALSO 

1458  15  23:D  1  HANDLES  ALL  OF  THE  CONTROL  CODES  (EOLiBS.DED  AND  BUFFER  OVER-  AND 

1459  15  23:D  1  UNDER-  FLOW  CONDITIONS.   INSERTCH  IS  CALLED  BY  THE  CRT  HANDLER  *) 

1460  15  23:0  0  BEGIN 

1461  15  23;i  0  REPEAT 

1462  15  23:2  0  0K:=TRUE;  (*  NO  ERRORS  THAT  INVALIDATE  THE  CURRENT  CHARACTER  HAVE  OCCURED  *) 

1463  15  23:2  4  CH:=GETCH; 

1464  15  23:2  11  IF  MAPT0C0MMAND(CH)=LEFT  THEN  CH:=CHR(aS); 

1465  15  23:2  26  IF  ORD{cH)  IN  C SP , hT » EOL t BS , DEL i ETX , ESC » DCl D  THEN 

1466  15  23:3  59  BEGIN 

1467  15  23:3  59  (*  <ETX>  AND  <ESC>  ARE  HANDLED  IN  THE  BODY  OF  INSERTIT  *) 

1468  15  23:4  59  IF  ORDCCH)  IN  CSP.HT3  THEN  SPACEOVER 


l^ffeS 

15 

23:4 

72 

l'+70 

15 

23:5 

76 

l**?! 

15 

23:b 

iJl 

1172 

15 

23:6 

35 

1^+73 

15 

23:3 

09 

147'+ 

15 

23:2 

09 

1^+75 

15 

23:3 

11 

l'+76 

15 

23:4 

11 

1^+77 

15 

23:4 

23 

l'+78 

15 

23:4 

30 

1479 

15 

23:5 

43 

1480 

15 

23:6 

43 

1481 

15 

23:& 

47 

1482 

15 

23:6 

52 

1483 

15 

23:5 

53 

1484 

15 

23:3 

57 

1485 

15 

23:1 

57 

1486 

15 

23:0 

62 

1487 

15 

23:0 

76 

1488 

15 

24:d 

1 

1489 

15 

24:d 

1 

1490 

15 

24:o 

0 

1491 

15 

24:i 

0 

1492 

15 

24:1 

11 

1493 

15 

24:i 

29 

1494 

15 

24:1 

38 

1495 

15 

24:1 

47 

1496 

15 

24:i 

55 

1497 

15 

24:i 

72 

1498 

15 

24:i 

87 

1499 

15 

24:o 

91 

1500 

15 

24:0 

04 

1501 

15 

25:d 

1 

1502 

15 

25:0 

0 

1503 

15 

25:1 

0 

1504 

15 

25:1 

17 

1505 

15 

25:2 

26 

1506 

15 

25:3 

26 

1507 

15 

25:3 

33 

1508 

15 

25:4 

42 

1509 

15 

25:2 

57 

ELSE 

IF    ORD(CH)=ECL    THEN    ErjDLINE 
ELSE 

IF    ORD(CH)     IN    CDC1,BS,0ELJ    THEN    BACKUP; 

End 

ELSE 

BEGIN  (*  A  CHARACTER  TO  INSERT!  ♦) 

IF  (CH<M.)  OR  {CH>'-M  THEN  CH:  =  «?«?  (*  NO  NON-PRINTING  CHARACTERS  *) 
IF  NOTEXTYET  THEN  FIXUP;  "iiMixiMb  uhAKAClERS  *) 

IF  CHECK(CURS0R+1)  AND  OK  THEN 
3EGIN 

notextyet:=false; 

ebuf'^ccurs0r3:=ch; 
cursor:=cursor+i 

END! 

end; 

UNTIL  0K5 

end; 

procedure  popdown; 

BEGIN^^^*^^  CONTEXT,  DOING  AN  IMPLIED  SCROLLUP  IF  NEC.  *) 

IF  CLEARED  THEN  ERaSETOEOL (X t LINE) 

ELSE  BEGIN  CLEARED:=TRUE ;  ERASEOS (X.LINE )  END; 

GOTOXY{RJUST,LINE); 

ERASET0E0L(RJUST,LINE) ; 

WRITE(CHR(LF)); 

JR^TE(CONTEXT:EO^^^^^^      '"''  EXITPRQMPT:  =TRUE,  LINE:=SCREENHEIGHT.l  END; 
^^FIRSTLINE:=FALSE;  {*  says  that  the  whole  SCREEN  HAS  BEEN  AFFECTED.  *) 

PROCEDURE  writesp(Ch:char;howmany:integer); 

BEGIN 

IF  x+howmany<=screenwidth  then  write(ch:howmany); 
IF  x+howmany>=screenwidth  then 

BEGIN 

GOtOXY(SCREENWIDTH,LINE) ; 

IF  x+howmany>screenwidth  then 

BEGIN  WRITE(»!»);  GOTQXY ( SCREENWIDTH,LINE)  END 
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1  ''■in 

1510  15  25:i  b7  X:=MIN(sCREENWIDTH,X  +  HOWMfl[\lY) 

l3ll  15  25:o  66  END; 

1512  15  25:o  34 

1513  15  26:d  1  PROCEDURE  CLEANSCREEM! 

ISl^t  15  26:d  1  (*  CODE  TO.  IF  POSSIBLE,  ONLY  ERASE  THE  LINE,  OTHERWISE  CLEAR 

1515  15  26:d  1  THE  SCREEN,   THEN  CALL  POPDOi<)N  *) 

151S  15  26:o  0  BEGIN 

1517  15  26:i  0  FIRSTLlNt::=FALSE; 

1513  15  26:i  ;+  IF  CLEARED  THEN 

1519  15  26:2  9  BEGI.M 

1520  15  26:3  9  IF  X<SCREENWIDTH  THEN  ERASETOEOL (X ,LINE) 

1521  15  26:2  22  END 

1522  15  26:i  25  ELSE 

1523  15  26:2  27  BEGIN 

1521  15  26:3  27  CLEARE:D:=TRUE  ;  ERASE0S(X,LINE)5 

1525  15  26:2  ^0  END? 

1526  15  26:i  40  line:=line+i; 

1527  15  26:i  18  IF  LINE>SCREENHEIGHT  THEN 

1528  15  26:2  55  BEGIN 

1529  15  26:3  55  line:=line-i ; 

1530  15  26:3  63  WRITELN; 

1531  15  26:3  69  EXItPROMPT: =TRUE 

1532  15  26:2  69  END; 

1533  15  26:i  73  IF  EOLDISTOQ  THEN  POPDOWN 
1531  15  26:o  80  END? 

1535  15  26:o  91 

1536  15  27:d  1  PROCEDURE  POPOV; 

1537  15  27:d  1  (*  WHEN  IN  FILLING  MODE,  THIS  PROCEDURE  IS  CALLED  WHEN  A  LINE  IS  OVERFLOWED 

1538  15  27:d  1  (X  >=  RIGHTMARGIN ) .   THE  WORD  IS  SCANNED  OFF  AND  "POPPED"  DOWN  TO  THE 

1539  15  27:D  1  NEXT  LINE.  *) 

1510  15  27:d  1  VAR 

1511  15  27:d  1  wlength:  integer; 

1512  15  27:d  2  save,ptr:  PTRTYPE; 

1513  15  27:d  1  word:  packed  array  co.,maxsw3  OF  char; 

1511  15  27:o  0  BEGIN 

1515  15  27:i  0  IF  NOTexTYET  THEN  FiXUP; 

1516  15  27:i  7  PTR:=MaX(SCAN{-MAXCHAR,  =  »-SE3UF'^CCURS0R-13), 

1517  15  27:i  21  SCAN(-MAXCHAR,  =  »  •  ,  EBUF'^CCURSOR-l  3)  ) +CURSOR ; 

1518  15  27:1  11  wlength:=cursor-ptr; 

1519  15  27:i  19  with  PagEZERO  DO  IF  WLENGTH>=RMARGIN-LMARGIN  THEN 

1550  15  27:3  60  BEGIN 


1551 

15 

27:^ 

60 

1552 

15 

2T.U, 

64 

1553 

15 

27:3 

63 

1554 

15 

27:i 

68 

1555 

15 

27:i 

81 

1556 

15 

27:i 

94 

1557 

15 

27:i 

07 

1558 

15 

27:i 

18 

1559 

15 

27:i 

29 

1560 

15 

27:i 

34 

1561 

15 

27:i 

39 

1562 

15 

27:i 

46 

1563 

15 

2713 

51 

1561 

15 

27:^ 

51 

1565 

15 

27:<+ 

54 

1566 

15 

27:'+ 

57 

1567 

15 

27:'+ 

60 

1568 

15 

27:3 

60 

1569 

15 

27:2 

63 

1570 

15 

27:3 

65 

1571 

15 

27:i 

70 

1572 

15 

27:1 

79 

1573 

15 

27:1 

81 

157tf 

15 

27:1 

85 

1575 

15 

27:1 

01 

1576 

15 

27:1 

12 

1577 

15 

27:0 

12 

1578 

15 

27  :o 

28 

1579 

15 

7:0 

0 

1580 

15 

7:1 

0 

1581 

15 

7:i 

3 

1582 

15 

7:1 

16 

1583 

15 

7:1 

25 

1584 

15 

7:1 

30 

1585 

15 

7:1 

32 

1586 

15 

7:1 

35 

1587 

15 

7:1 

43 

1588 

15 

7:1 

46 

1589 

15 

7:1 

53 

1590 

15 

7:1 

58 

1591 

15 

7:1 

61 

WRlTESP(CHil) ; 

exitcpopov) 
end; 
if  ch=»-«  then  white( •-• ) ; 
g0t0xy(x-wlength+1,l1ne) ; 

ERASET0E0L(X-WLENGTH+1,LINE) ; 

'^0VERIGHT(EBUF-CPTRJ.EBUF-CPTR  +  3J,WLENGTH): 
M0VELEFT(E3UF'*CPTR  +  3a,W0RD.WLENGTH); 
CURS0R:=CURS0R+3; 

E3UF'^CPTR]:=CHR(E0L)  5 

ebuf'^cptR+id:=chr(dlE)  ; 

WITH  PaGEZERO  do  IF  AUTOINDENT  THEN 
BEGIN 

c3RS0R?=p?Rr  '*    ^"  ^'■'^'"^  ^°  ™  INDENTATION  OF  THE  LINE  ABOVE  *) 

getleading; 
cursor:=save 
end 

ELSE 

blanks:=l«argin; 

EBUF'*CptR+23:=CHR(BLANKS+32)  ; 

cleanscreen? 
x:=blanks; 

GOTOXY(X»LINE) ;  WRITE{ WORD: WLENGTH) ; 

x:=x+wlength; 

NOTEXTyET:=FALSE 
END; 

begin  (♦  insert  *) 
cleared:=false; 

"hP^^^-=^^^'^<"'^^CHAR,=CHR<EOL),EBUF'^CCURSORD)» 
MOVELEfT(E8UF'^CCURSOR3.CONTEXTC03,EOLDIST)  ; 

rjust:=screenwidth-eoldist; 
slamright; 

savebufcount:=bufcount; 

promptline;=insertprompt; 

PROMPT; 

exitprompt:=false;     needprompt:=true; 
leftpart:=cursor-i; 
notextyet:=false; 
findxy(x»line);     gotoxy(x,lins")  ; 
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1592 

15 

7:i 

73 

1593 

15 

7:i 

78 

159^ 

15 

7:1 

81 

1595 

15 

7:2 

86 

1596 

15 

7:3 

91 

1597 

15 

7:4 

91 

1598 

15 

7:3 

13 

1599 

15 

7:2 

13 

1600 

15 

7:3 

15 

1601 

15 

7:n 

15 

1602 

15 

7m^ 

18 

1603 

15 

7:n 

23 

1601+ 

15 

7:i+ 

29 

1605 

15 

715 

3t 

1606 

15 

7:1 

42 

1607 

15 

7:3 

66 

1608 

15 

7:1 

66 

1609 

15 

7:2 

66 

1610 

15 

7:2 

66 

1611 

15 

7;3 

96 

1612 

15 

7:4 

96 

1613 

15 

7:5 

07 

161f 

15 

7:tf 

45 

1615 

15 

7:5 

47 

1616 

15 

7:5 

54 

1617 

15 

7:6 

58 

1618 

15 

7;6 

71 

1619 

15 

7:tf 

79 

1620 

15 

7:'+ 

94 

1621 

15 

7:«+ 

05 

1622 

15 

7:^ 

08 

1623 

15 

7;5 

16 

162«+ 

15 

7:6 

16 

1625 

15 

7:6 

18 

1626 

15 

7:5 

23 

1627 

15 

713 

23 

1628 

15 

7:2 

23 

1629 

15 

7:3 

25 

1630 

15 

7:4 

25 

1631 

15 

7:5 

30 

1632 

15 

7:6 

30 

1(j2 

erasetoeol(x,line) ; 

FIRSTLliSiE:=TRUE; 

IF  EOLDISTOO  THEN  (*  A  CONTEXT  NEEDS  TO  BE  DISPLAYED  ♦) 

IF  RJUST>X  THEN  (*  AND  IT  WILL  FIT  ON  THE  CURRENT  LINE  ...  ♦) 
BEGIN 

G0TQXY(RJUST,LINE);  WRITE( CONTEXT:EOLOIST) ;  GOTOXY( Xt LINE  ) 
END 
ELSE  (♦  AND  IT  WON'T  FIT  ON  THE  CURRENT  LINE  *) 
BEGIN 

firstline:=false; 

eraseos(x»line) ; {*  clear  the  screen  *) 

writeln; 

if  LINE=SCREENHEIGHT  THEN 

BEGIN  hne:=screenheight-i;  exitprompt:=true  end; 

G0T0XY(RJUST,LINE+1) !  WRITE(C0NTEXT;E0LDIST);  G0T0XY(X,LINE) 

end; 
repeat 
insertch; 

IF  NOT  (QRD(CH)  in  CEQL.ETX.ESC »DELf DC13)  THEN 
BEGIN 

if  TRANSLATECCH3SLEFT  THEN 

BEGIN  IF  X<=SCREENWIDTH  THEN  WRITE ( CHR(BS )» •  •.CHR(BS));  X:=X-1  END 
ELSE 

IF  CH=CHR(HT)  THEN  WRITESPC  », SPACES) 
ELSE 

IF  PAGEZERO. FILLING  AND  (X+1>=PAGEZER0.RMARGIN)  THEN  POPOV 

ELSE  WRITESP(CH,1); 
IF  NOT  PAGEZERO. FILLING  AND  { X=SCREENWlDTH-8)  AND  (CHOCHRCBS)) 

THEN  WRITE(CHR(BELL) ) ; 
IF  (EOLDISTOO)  AND 

(X>=RJUST)  AND  FIRSTLINE  THEN   (*RAN  INTO  CONTEXT  ♦> 
BEGIN 

POPDOWN; 
G0T0XY(X,LINE) 

end; 

END 
ELSE  (*  CH  IN  CE0LiETXtESC«DELt0ClD  *) 
BEGIN 

IF  CH=CHR(EOL)  THEN 
BEGIN 

cleanscreen; 


1633 

15 

7:6 

32 

163'+ 

15 

716 

35 

1635 

15 

715 

40 

1636 

15 

7:4 

40 

1637 

15 

7:5 

42 

1638 

15 

7:& 

49 

1539 

15 

7:7 

49 

1640 

15 

7:8 

54 

le^+i 

15 

7:9 

54 

1642 

15 

7:9 

59 

1643 

15 

7:9 

64 

1644 

15 

7:9 

73 

1645 

15 

7:9 

80 

1646 

15 

7:8 

89 

1647 

15 

7:7 

89 

1648 

15 

7:8 

91 

1649 

15 

7:9 

99 

1650 

15 

7:7 

09 

1651 

15 

7:7 

12 

1652 

15 

7:7 

21 

1653 

15 

7:6 

26 

1654 

15 

7:5 

26 

1655 

15 

7:6 

28 

1656 

15 

7:7 

33 

1657 

15 

7:8 

33 

1658 

15 

7:7 

43 

1659 

15 

7:3 

46 

1660 

15 

7:1 

46 

1661 

15 

7:i 

59 

1662 

15 

7:1 

71 

1663 

15 

7:i 

74 

1664 

15 

7:0 

76 

1665 

15 

7:0 

92 

1666 

15 

7:0 

92 

1667 

15 

7:q 

92 

1668 

15 

7:0 

92 

1668 

15 

7:0 

92 

1669 

15 

28:d 

1 

1670 

15 

28:d 

1 

1671 

15 

28  :d 

1 

1672 

15 

28:d 

5 

x:=BLANKs; 

GOTOXY(X,LIIME)  ; 

END 
ELSE 

IF  CH=CHR(DEL)  THEN 
BEGIN 

IF  LINE<=1  THEN   (*  RUBBED  OUT  ALL  OF  WHAT  WAS  ON  THE  SCREEN  *) 
3EGIN 

bufcount:=cursor+i; 

EBUF'*i:CURS0R3:=CHR(E0L)  ; 

CENTERCURS0R(LINE»MIDDLE»TRUE) ; 

IF  EOLDISTOO  then  POPDOWN5 

IF  EXITPROMPT  THEN  BEGIN  PROMPT!  EXITPROMPT:=FALSE  END 

ELSE 

BEGIN  eOTOXY(0»LINE);  cleared:=false; 

erasetoeol(0iLine)5  line:=line-i  end? 
getleading5 

x:=blanks-bytes+curs0r-linestart5 

G0T0XY(X»LINE) 
END 
ELSE 

IF  CH=CHR(DC1)  THEN 
BEGIN 

X:=0;  SOTOXYCXfLINE);  ERASETOEOL(XtLINE) 
END; 
END; 
UNTIL  CH  IN  [:CHR(ETX)»CHR(ESC)D; 
IF  CH=CHR{ESC)  THEN  CURS0R:=LEFTPART+1 ; 

bufcount:=savebufcount; 

WRAPUP; 
END! 


{*$I  INSERTIT   *) 
(*$I  MOVEIT     ♦) 

PROCEDURE  MOVEIT; 
VAR 

SCROLLMARK,XtLINE,i:  INTEGER; 

EXITPROMPT:  BOOLEAN!  (♦  PROMPT  AFTER  LEAVING  MOVEIT!  ♦) 
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1673  15  28:d  6  OLDLINE , OLDX :  INTEGEK; 

167tf  15  28:D  8  NEWDIST,DIST:  INTEGER; 

1675  15  28:d  10  DOFFSCREEN , ATEND, INREPLACEt INOELETE :  BOOLEAN? 

1676  15  28:d  m  PTR, ANCHOR, OLDCURSOR:  PTRTYPE; 

1677  15  28:d  17 

1678  15  29:d  1  PROCEDURE  SCROLLUPC BOTTOMLINE : PTRTYPE ;  HOWMANYI  INTEGER); 

1679  15  29:d  3  (*  BOTTOmlINE  IS  THE  "LINESTART"  OF  THE  LINE  TO  BE  SCROLLED  UP  *) 

1680  15  29:d  3  VAR 

1681  15  29:d  3  PTR:  ptrtype; 

1682  15  29:d  f  i:  INTEGER; 

1683  15  29:o  0  BEGIN 

168^  15  29:0  0  (*  DISPLAY  THE  NEXT  LINE  ON  THE  BOTTOM  OF  THE  SCREEN  *) 

1685  15  29:i  0  ii=o; 

1686  15  29:i  3  PTR:  =SCAN(  MAXCHAR,=CHR  (EOL)  lEBUF'^CLINElPTRD) +LINE1PTR+1 ; 

1687  15  29:i  2H  WHILE  (KHOWMANY)  AND  <PTR<BUFCOUNT)  DO 

1688  15  29:2  33  BEGIN 

1689  15  29:3  33  LiNElPTR:  =PTR ;  PTR:=SCAN(  MAXCHAR,=CHR(EOL)  ,EBUF'*CPTRD)+PTR-»-l ; 

1690  15  29:3  54  i:=I+l 

1691  15  29:2  55  END? 

1692  15  29:i  61  i:=o; 

1693  15  29:i  6t  GOTOXY( Q, SCREENHEIgHT) ; 

1694  15  29:i  69  REPEAT 

1695  15  29:2  69  i:=i+i; 

1696  15  29:2  74  BLANKS:=LEADaLANKS{BOTTOMLlNE, BYTES ) ; 

1697  15  29:2  84  WRITe(CHR(LF)) J 

1698  15  29:2  92  LINEOUT(BOTTOMLlNEtBYTES»BLANKStSCREENHEIGHT) ; 

1699  15  29:2  00  LINE:=LINE-l; 

1700  15  29:i  08  until  (i>=howmany)  or  (b0tt0hline>=bufc0unt-1 ) 5 

1701  15  29:1  19  exitprompt:=true; 

1702  15  29:0  23  END(*  SCROLLUP  *); 

1703  15  29:0  40 

1704  15  30:D  1  PROCEDURE  CLEAR ( XI ,Yl .X2 .Y2 :  INTEGER);  FORWARD? 

1705  15  30:d  5 

1706  15  31:d  1  PROCEDURE  CENTER; 

1707  15  3i:o  0  BEGIN 

1708  15  3i:i  0  IF  INDELETE  THEN 

1709  15  31:2  5  BEGIN 

1710  15  31:3  5  IF  LlNE>=SCREENHEIGHT  THEN 

1711  15  31:4  12  BEGIN 

1712  15  31:5  12  CENTERCURS0R(LINE«2,TRUE); 

1713  15  31:5  20  IF  ABS(CURSOR-ANCHOR)  >  ABS(DIST)  THEN  CLEAR ( 0 tl .MAX (X-1 , 0 ) f LINE) 


17m  15  31:4  1+9          £,,10 

1715  15  31:3  51        ELSE 

171G  15  31:4  53          3EGI(\I 

1717  15  31:5  53            CEMTERCURS0R{LINE,SCREENHEIGHT-1,TRUE) ; 

1718  15  3115  63            GOTOXY ( X , LiNt ) ; 

1719  15  31:5  72            IF  ABS(CURSOR-ANCHOR)  >  A3S(DIST)  THEN  WRITE ( CHR ( 11 ) ) 

1720  15  31:4  93          END; 

1721  15  31:3  93     doffscreen:=true; 

1722  15  31:2  97      END 

1723  15  3i:i  97    ELSE 

^lll  J!  l^'^  ^^      ^^    (COMMANDrPARAC)  AND  ( ( DIRECTION= ♦ < • )  OR  (LINE  MOD  SCREENHEIGHT=OLDLINE ) ) 

1725  15  31:2  15        THEN  CENTERCURSOR ( LINE. OLDLINEtTRUE ) 

1726  15  31:2  25        ELSE  CENTERCURsOR (LINE. MIDDLE, TRUE) ; 

1727  15  3i:i  1+0    IF  EXITPROMPT  AND  (  COMMANDOQUITC  )  THEN 

1728  15  3i:2  f9      BEGIN 

1729  15  31:3  49        PROMPT;  EXITPRqMPT :=FALSE 

1730  15  31:2  52      end; 

1731  15  3i:i  56   oldline:=line;  oldx:=x; 

1732  15  3i:o  68  END; 

1733  15  3i:o  80 

173f  15  32:d  1  PROCEDURE  UPMOVE; 

1735  15  32:D  1  VAR  I.'INTEGER; 

1736  15  32:0  0  BEGIN 

1737  15  32:i  0    i:=l; 

1738  15  32:1  3    GETLEADING; 

1739  15  32:1  6    (*  FIND  THE  LINE  FIRST  *) 

17*tO  15  32:1  6    WHILE  ( I<=REPEATFACTOR )  AND  ( LINESTART>1 )  DO 

17*tl  15  32:2  15      BEGIN 

17tf2  15  32:3  15       CUrsOR:=LINESTART-1;  (*  LAST  CHAR  OF  LINE  ABOVE  *) 

17t3  15  32:3  20       GETLEADING; 

I7f4  15  32;3  23      line:=line-i ;  i:=I+l; 

l7'+5  15  32:2  36      end; 

^^lly  J=  ^oi?  !5    ^*  ^^    POSSIBLE  SET  THE  CURSOR  AT  THE  SAME  X  COORD  WE  CAME  FROM.   OTHERWISE, 

^IZI  il  ;S*^  ^®       ^^'''  ^^  EITHER  TO  THE  BEGINNING  OF  THE  BUFFER,  THE  BEGINNING  OF  TEXT 

1748  15  32.2  38       ON  THAT  LINE,  OR  THE  END  OF  THE  TEXT  ON  THAT  LINE  *) 

17«+9  15  32;i  38    CURSOR:  = 

1750  15  32:1  38             MAXd,      (*  THE  BEGINNING  OF  THE  BUFFER  ♦) 

1751  15  32:1  39                 MAX(STUFFSTART,   (*  THE  BEGINNING  OF  THE  TEXT  ♦) 

;ll%  J^  ^2:1  40                    MlN(X-BLANKS+ByTES+LlNESTART,  (♦  SAME  COL  *) 

Ttru  1=  Izl^  '*^                        SCAN(MAXCHAR,=CHR(E0L),EBUF'^I:CURS0R3)+CURS0R  (*  EOL  ♦) 

1' 34  15  32*1  60                          ) 

J  bo 


1G6 


1755 

15 

32:i 

62 

1756 

15 

32:i 

67 

1757 

lb 

i2:i 

79 

1758 

15 

32:o 

88 

1759 

15 

32:o 

02 

1760 

15 

33:d 

1 

1761 

15 

33:o 

1 

1762 

15 

33  :d 

1 

1763 

15 

33:o 

2 

1764 

15 

33  ;o 

0 

1765 

15 

33:i 

0 

1766 

15 

3311 

3 

1767 

15 

33:i 

18 

1768 

15 

3312 

29 

1769 

15 

33:3 

29 

1770 

15 

33:3 

34 

1771 

15 

33:3 

49 

1772 

15 

33:4 

54 

1773 

15 

33:5 

54 

I77f 

15 

33:5 

62 

1775 

15 

33:5 

67 

1776 

15 

33:6 

76 

1777 

15 

33:7 

76 

1778 

15 

33:6 

80 

1779 

15 

33:4 

80 

1780 

15 

33:2 

80 

1781 

15 

33:i 

82 

1782 

15 

33:2 

89 

1783 

15 

33:3 

02 

1784 

15 

33:2 

02 

1785 

15 

33:3 

06 

1786 

15 

33:1 

16 

1787 

15 

33:1 

19 

1788 

15 

33:1 

19 

1789 

15 

33:1 

19 

1790 

15 

33:1 

19 

1791 

15 

33:1 

22 

1792 

15 

33:1 

23 

1793 

15 

33:1 

30 

1794 

15 

33:1 

43 

1795 

15 

33:1 

45 

)  i 

IF  LINE<1  THEN 
EMD(*  UPALINE  *) ' 


CENTEK; 


PROCEDURE  OOWNMOVE; 
VAR 

i:  integer; 
nexteol:  ptrtype; 

BEGIN 

i:=i; 

NEXTEOL  :=SCAN(MAXCHAR.=CHR(EOL)fEBUF'*C  CURSOR  3  )+CURSOR; 
WHILE  (NEXTEOL<BUFCOUNT-1)  AND  { I<=REPEATFACTOR )  DO 
BEGIN 

cursor:=nexteol+15 

nexteol: -SCAN  (MAXCHARt=CHR(EOL)  .EBUF'*CCURS0R3)+CURS0R; 

IF  nexteol<bufcount  then 

BEGIN 

line:=line+ij 
i;=i+i? 

IF  LINE=SCREENHEIGHT+1  THEN 
BEGIN 

scrollmark : =curs0r ; 
end; 
end; 
End; 
IF  line>screenheight  then 
IF  (line-screenheight>=screenheight)  or  (indelete)  then 

CENTER 

else 

SCR0LLUP( SCROLLMARK, L I NE-SCREENHEIGHT) ; 
GETLEADING; 

(*  IF  POSSIBLE  SET  THE  CURSOR  AT  THE  SAME  X  COORO  WE  CAME  FROM.   OTHERWISEt 
SET  IT  EITHER  TO  THE  END  OF  THE  BUFFER*  THE  BEGINNING  OF  TEXT 
ON  THAT  LINE,  OR  THE  END  OF  THE  TEXT  ON  THAT  LINE  ♦) 
CURS0R:=MIN(BUFC0UNT-1,       (*  END  OF  THE  BUFFER  ♦) 

MAX(STUFFSTART,     (♦  NOT  IN  THE  INDENTATION  *) 

MIN(X-BLANKS+BYTES+LINESTART  (♦  WHERE  IT  WANTS  TO  BE  *) 
,  SCAN  (MAXCHAR,=CHR(EOL)»EBUF'^C CURSOR ])+CURSOR 
) 
) 


1796 

15 

33:i 

50 

1797 

15 

33  :o 

62 

1798 

15 

33  :n 

76 

1799 

15 

34:d 

1 

1800 

15 

34  :o 

0 

1801 

15 

34:i 

0 

1802 

15 

3f  :i 

3 

1803 

15 

34;2 

14 

laof 

15 

34:3 

14 

1805 

15 

34:3 

23 

1806 

15 

34:3 

36 

1807 

15 

34:3 

58 

1808 

15 

34:3 

66 

1809 

15 

34:2 

69 

1810 

15 

34:1 

71 

1811 

15 

34:1 

88 

1812 

15 

34:1 

97 

1813 

15 

34:0 

06 

1814 

15 

3410 

20 

1815 

15 

35  :d 

1 

1816 

15 

35:d 

1 

1817 

15 

35:d 

1 

1818 

15 

35:0 

0 

1819 

15 

35:1 

0 

1820 

15 

35:1 

15 

1821 

15 

35:2 

28 

1822 

15 

35:3 

28 

1823 

15 

35:3 

37 

1824 

15 

35:3 

42 

1825 

15 

35;3 

45 

1826 

15 

35:3 

48 

1827 

15 

35:3 

56 

1828 

15 

35:3 

69 

1829 

15 

35:2 

80 

1830 

15 

35:1 

86 

1831 

15 

35:2 

93 

1832 

15 

35:3 

06 

1833 

15 

35:2 

06 

1831 

15 

35:3 

10 

1835 

15 

35:1 

20 

1836 

15 

35:1 

33 

DO 


} ; 

END(*    DOii^MMOVE    *)  ; 

PROCEDURE  LEFTMOVE; 
BEGIN 

GETLEADING;  (*  SET  UNESTART  AND  STUFFSTART  *) 
'''^BEGI,^^'^^^''^"^^*^^^^^^^°^"^^''^*^^*^^°'^'  ^^°  (CURSOR>REPEATFACTOR) 

IF'^rBlp^^ruR^np^-rSI^ro'?'''*'^'^'''"^-^^^'^^  «*  CHARS  MOVED  OVER  *) 

IF  EBUF^CCURS0R3=CHR(E0L)  THEN  CURS0R:=CURS0R-1 ; 

iTMr?-.'T!!f\'?^'^^^""'^^^"'^'^'=^^f^'^°'-»'^BUF-[:cURSORD)+CURSOR,l); 

GETLEADING;  (*  RESET  LiNESTART  AND  STUFFSTART  *) 

END! 

CURSOR:=MAX(STUFFSTART,MAX(CURSOR-REPEATFACTOR,1) ) : 
IF  LINE<1  THEN  CENTER; 

FINDXY(X»LINE)J 

END  (♦  LEFTMOVE  *) f 

PROCEDURE  RlGHTMOVEl 
VAR 

EOLPTR;  ptrtype; 
BEGIN 

EOLPTR :=SCAN(MAXCHAR»=CHR{E0L)»EBUF^CCURS0Rl)+rURSOR I 
W«lLE^(EOLPTR<CURSOR^REPEATFACTORrAND  (EOLpIr<^^^^ 

repeatfactor:=repeatfactor-{eolptr-cursor+i) ? 

rrrP^AArM?'-''^'^*^'  <*  BEGINNING  OF  THE  LINE  BELOW  ») 
GETLEADING; 

cursor:=stuffstart; 
line:=line+i; 

IF  LINE=SCREENHE1GHT+1  THEN  SCR0LLMARK:=LINESTART; 
^^EOlpTR:=SCAN(MAXCHAR,=CHR(EOL).EBUF-CCURSORD)+CURSOR 
IF  LINE>SCREENHEIGHT  THEN 


DO 


IF  (LINE-SCREENHEIGHT>=SCREENHEIGHT) 

CENTER 
ELSE 

SCROLLUP(SCROLLMARK,LINE-SCREENHElGHT) ; 

CURS0R:=MIN(BUFC0UNT-1,CURS0R+REPEATFACT0R); 
FINDXY(X»LINE); 


OR    (INDELETE)    THEN 
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16S 

1837  15  35:0  ^2  zWi*   rightmove  *); 

1838  15  35:o  56 

1839  15  36:D  1  PROCEDURE  LINEMOVE (REPEATFACTOR:  INTEGER); 

1840  15  36:d  2  VAR  I:  INTEGER; 

1841  15  36:o  0  BEGIN 

1842  15  36:i  0  i:=i; 

IS'+S  15  36:i  3  IF  DIRECTI0N=«<'  THEN 

1844  15  36:2  8  BEGIN 

1845  15  36:3  8  WHILE  ( I<=REPEATFACT0R )  AND  <CURS0R>1)  DO 

1846  15  36:4  17  BEGIN 

1847  15  36:5  17  IF  EBUF^CCURSOR 3=CHR ( EOL )  THEN  CURS0R:=CURS0R-1 ;  {*  NULL  LINE  CASE  *) 

1848  15  36:5  30  CURSOR  :=SCAN( -MAXCHARf=CHR<EOL)  ,EBUF'*CCURSORD)+CURSOR  J  (♦  1  UP  ♦) 

1849  15  36:5  46  IF  CURS0R>=1  THEN  BEGIN  LINE:=LINE-1 ;  i:=I+l  END; 

1850  15  36:4  64  END; 

1851  15  36:3  66  CURSOR: =MAX ( 1 .CURSOR) ;  (*  BACK  INTO  REALITY  *) 

1852  15  36:3  75  ATEND:=  (CURS0R=1); 

1853  15  36:3  81  IF  lINE<1  THEN  CENTER 

1854  15  36:2  88  END 

1855  15  36:i  90  ELSE 

1856  15  36:2  92  BEGIN  (*  DIRECTlON=»>»  *) 

1657  15  36:3  92  WHIlE  ( I<=REPEATFACT0R)  AND  (CURS0R<BUFC0UNT-1 )  DO 

1858  15  36:4  03  BEGIN 

1859  15  36:5  03  CURS0R:=SCAN(MAXCHAR«=CHR (EOL) tEBUF^CCURS0R3) +CURS0R+1 ;  (♦IDOWN*) 

1860  15  36:5  20  IF  CURS0R<BUFC0UNT  THEN 

1861  15  36:6  25  BEGIN 

1862  15  36:7  25  i:=I+X;  LINE:=LINE+H 

1863  15  36:7  38  IF  LINE=SCREENHEIGHT+1  THEN  SCR0LLMARK:=CURS0R J 

1864  15  36:6  51  END 

1865  15  36:4  51  END; 

1866  15  36:3  53  ATEND:=  (CURS0R>=BUFC0UNT-1 ) ; 

1867  15  36:3  61  IF  LINE>SCREENHEIGHT  THEN 

1868  15  36:4  68  IF  (LINE-SCREENHEIGHT>=SCREENHEIGHT)  OR  {COMMAND=PARAC ) 

1869  15  36:4  78  OR  INREPLACE  OR  INDELETE 

1870  15  36:4  83  THEN 

1871  15  36:5  89  CENTER 

1872  15  36:4  89  ELSE  SCROLLUP ( SCROLLMARK.LINE-SCREENHEIGHT) { 

1873  15  36:3  03  CUrs0R:=MIN{CURS0R ,8UFC0UNT-1 ) 

1874  15  36:2  07  END; 

1875  15  36:i  14  GETLEAqING; 

1876  15  36:i  17  CURSOR:rSTUFFSTART ;  (*  FORCED  TO  BEGINNING  OF  STUFF  ♦) 

1877  15  36:i  20  x:=blanks; 


1878  15  36:o  ^^l    END(*    LlNEi^lOVE    *); 

1879  15  36:0  40 

1880  15  57rj              1  PROCEDURE  JUMPBEGIN; 

1881  15  5710              0  BEGIN 

Jflo?  }l  11'^               °    CURSOR:=l;  CENTERCURSOR(TRASH»i, false) 

1883   15  37:o      8  END; 

188'+   15  37:o  24 

1885  15  38:D      1  PROCEDURE  JUMPEND; 

1886  15  38:o      0  BEGIN 

1888  15  nil  iS   ^CURSOR:=BUFCOUNT-l;  CENTERCURSOR ( TRASH, SCREENHEIGHT .FALSE) 

1889  15  38:o  26 

1890  15  39:d      1  PROCEDURE  ADJUSTING; 

1891  15  39:d      1  LABEL  i; 

1892  15  39:d      1  TYPE 

1894  II  IViD              ^         MODES={RELATIVE,LEFTJtRlGHTj, CENTER)  5 

1895  15  39:d      1    LLENGTH,TDELTA»i;  INTEGER; 

1896  15  39:d    4   savedir:  char; 

1897  15  39:d  5         MODE:    NIOOES; 

1898  15  39:d  6 

Jonn  il  I^°*°  ^  PROCEDURE  OOIT(DELTa:INTEGER); 

1900  15  4o;d  2  var 

i!2J  15  4o:d  2   eoldist:  integer; 

^lnt      ii  lnl°n  ^         ^•'  PACKED  ARRAY  CO.  .MAXSTRINGD  OF  CHAR; 

1903   15  4-o:o  0  BEGIN 

1905   li  JSm  S    ?rb^;°^^^'  <*  2^^  LINESTART.  STUFFSTART.  and  BLANKS  *) 

Hal       ,1  aS:J  ,f    ^^    BLAnKS+DELTA<0  THEN  DELTa:=-BLANKS; 

1907  15  lo'l  II         IF  (EBuF-CLINESTART3=CHR(0LE))  AND  (STUFFSTART-LINESTART=2)  THEN 

1908  15  ^Sii  II              X:=0RD(EBUF-CLINESTART+XD)+DELTA-32 

1909  15  40:2  43      BEGIN 

J^J?  J=  aS:?  '^^      ^^   stuffstart-linestart>2  then 

1912  15  loll  63        ^j_^0VELEFT(EBUF-CSTUFFSTARTD,EBUF-CLINESTART*23.BUFC0UNT-STUFFSTART) 

1913  15  40:4  65          beGIN 

^lil     il  nV.^  ^^                     I'"  bufcount>bufsize-ioo  then 

1915   15  40:6  72              BEGIN 

III7      ts  IV'l  la                                       ERRORCBUFFER  overflow, NONFATAL); 

,Q,I  :=  .'^  ^^                           exit(adjusting) 

1918   15  40:6  98              END 


1(59 


1919 

15 

40:5 

58 

1920 

15 

4o:o 

00 

1921 

15 

40:4 

13 

1922 

15 

40:3 

13 

1923 

15 

4o:4 

20 

1924 

15 

40:5 

20 

1925 

15 

40:5 

29 

1926 

15 

40 : 4 

38 

1927 

15 

40:3 

38 

1928 

15 

40:3 

43 

1929 

15 

4o:2 

49 

1930 

15 

4o:i 

49 

1931 

15 

4o:i 

60 

1932 

15 

4o:i 

68 

1933 

15 

4o:i 

82 

13ZI* 

15 

40  :o 

01 

1935 

15 

4o:o 

14 

1936 

15 

39:o 

0 

1937 

15 

39:i 

0 

1938 

15 

39:2 

0 

1939 

15 

39:3 

0 

igt+o 

15 

39:3 

14 

19m 

15 

39:3 

18 

19't2 

15 

39:3 

26 

1943 

15 

39:3 

33 

1944 

15 

39:3 

36 

19'+5 

15 

39:3 

39 

1946 

15 

39:3 

48 

1947 

15 

39:3 

51 

1948 

15 

39:4 

51 

1949 

15 

39:4 

58 

1950 

15 

39;  4 

66 

1951 

15 

39:4 

70 

1952 

15 

39:5 

75 

1953 

15 

39:6 

75 

1954 

15 

39:5 

95 

1955 

15 

39:4 

98 

1956 

15 

39:5 

00 

1957 

15 

39:4 

17 

1958 

15 

39:5 

28 

1959 

15 

39:6 

28 

170 

LLSE 

M0VERIGHT(tBUF''CSTU!^FSTART:,EBUF''CLIf\lESTART  +  2:»BUFC0UNT-STUFFSTART) 
END! 
IF    LlNESTART  +  2<>iiTUFFSTART    THEN 
3EGIN 

READJUST (LINESTART* LI NESTART+2-STUFFSTART) ; 
3UFC0UrjT:=BUFC0UNT  +  Ll'^ESTART+2-STUFFSTART; 

end; 
ebuf*clinestart3:=chr(dle) ; 
x:=3lanks+oelta5 
end; 
ebuf'^clinestart+1]:=chr(x+32)  ; 
cursor :=linestart+2;  getleaqing; 

GOTOXY(0»LINE) ;  ERaSETOEOL { 0 t LINE ) ;  (*  ERASE  THE  LINE  *) 
LI NEOUT(LINESTART,BYTESt BLANKS t LINE) ;  GOTOXY ( X , LINE  )  ; 
END(*  DOIT  *) ; 

BEGIN  (*  ADJUSTING  *) 
WITH  PagEZERO  do 
BEGIN 

savedir:=direction;   exitprompt:=false;   indelete:=false:   lastpat:=cursor; 

inreplace:=true; 

pro!uiptline:=adjustprompt; 

prompt;  needprompt:=true; 

mode:=relative; 

SHoirtCURSOR; 
FInDXY(X,LINE) ; 

tdelta:=o; 
repeat 
ch:=getch; 

command:=maptocommanD(CH)  ; 
infinity:=false; 
if  command=slashc  then 
begin 
repeatfactor:=i;  infinity:=true;  ch:=getch;  command:=translatecch3 

END 
ELSE 

if  command=digit  then  repeatfactor:=getnum  ELSE  repeatfactor:=i; 
if  command  in  cup, down:  then 
begin 
if  command=up  then  direction:=«<«  else  direction:='>»; 


1960 

15 

i5:6 

41 

1961 

15 

39:6 

ll-u 

1962 

15 

39:6 

'+8 

1963 

15 

39:7 

62 

196'4 

15 

35:3 

62 

1965 

15 

39:8 

67 

1966 

15 

39:3 

70 

1967 

15 

39:9 

76 

1968 

15 

39:o 

76 

1969 

15 

39:o 

82 

1970 

15 

39:i 

86 

1971 

15 

39:2 

86 

1972 

15 

39:2 

99 

1973 

15 

39:2 

02 

1971 

15 

39:2 

11 

1975 

15 

39:2 

24 

1976 

15 

39:3 

2f 

1977 

15 

39:2 

43 

1978 

15 

39:1 

60 

1979 

15 

39:9 

60 

1980 

15 

39:7 

60 

1981 

15 

39:5 

60 

1982 

15 

39:if 

62 

1983 

15 

39:5 

64 

igst 

15 

39:6 

69 

1985 

15 

39:7 

69 

1986 

15 

39:6 

78 

1987 

15 

39:5 

81 

1988 

15 

39:6 

83 

1969 

15 

39:7 

88 

1990 

15 

39:a 

88 

1991 

15 

39:7 

96 

1992 

15 

39:6 

99 

1993 

15 

39:7 

01 

1994 

15 

39:s 

09 

1995 

15 

39:9 

09 

1996 

15 

39:9 

12 

1997 

15 

39:9 

25 

1998 

15 

39:0 

30 

1999 

15 

39:9 

40 

2000 

15 

39:0 

42 

i:  =  i: 

aten[j:=false; 

while  not  atend  and  ( ( i<=repeatfactor )  or  infinity)  do 

BESIN 

i:=i+i5 

LINEMOVEd)  ; 
IF  'JCT  ATEND  THEN 
BEGIN 

IF  MODE=RELATIVE  THEN  DOIT(TDELTA) 
ELSE 
BEGIN 

LLENGTH:=SCAN(MAXCHAR,=CHR(E0L) fEBUF^CSTUFFSTART]) ; 

case  mode  of 
leftj:  doit(lmargin-blanks) ; 

rightj:    D0IT(  (RMARGIN-LLENGTH+D-BLANKS)  ; 

center: 

D0IT(((RMARGIN-LMARGIN+1)-LLENGTH)  DIV  2-BLANKS+LMAReiN) 
END  (*  CASE  *) 
END  (*  ELSE  *) 

End;  (*  if  not  atend  *) 

END  (♦  while  ...  *) 
END 
ELSE 

IF  COMMANDrLEFT  THEN 
BEGIN 

doit(-repeatfactor) ;  tdelta:=tdelta-repeatfactor;  mode:=relative 

END 
ELSE 

IF  command=right  then 

BEGIN 

ooit(Repeatfactor) ;  tdelta:=tdelta+repeatfactor;  mode:=relative 

END 
ELSE 

if  command  in  clistc.replacec,copyc3  then 
begin 
getleading5 

LLENGTH:=SCAN(MAXCHAR,=CHR(E0L) tEBUF^CSTUFFSTARTD) ; 
IF  C0MMAND=LISTC  THEN 

BEGIN  mode:=leftj;  doit(lmargin-blanks)  end 

ELSE 

IF  command=replacec  then 
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S    i 


z 


i?001 

15 

39 

:i 

^1 

2002 

15 

39 

;o 

61 

2003 

15 

39 

:i 

63 

2004 

15 

39 

.2 

63 

2005 

15 

39 

.2 

66 

2006 

15 

39 

.1 

35 

2007 

15 

39 

:8 

87 

2008 

15 

39. 

\i 

87 

2009 

15 

39 

,8 

69 

2010 

15 

39, 

4 

02 

2011 

15 

39: 

3 

09 

2012 

15 

39; 

2 

12 

2013 

15 

39: 

0 

12 

2014 

15 

39: 

0 

32 

2015 

15 

4i: 

,D 

3 

2016 

15 

41, 

0 

0 

2017 

15 

41 

:i 

0 

2018 

15 

41. 

\2 

5 

2019 

15 

41 

13 

10 

2020 

15 

41, 

\2 

28 

2021 

15 

4i: 

!3 

33 

2022 

15 

4i: 

;4 

33 

2023 

15 

41 

;4 

41 

2021 

15 

4i: 

.3 

65 

2025 

15 

4i: 

1 

68 

2026 

15 

4i: 

0 

70 

2027 

15 

4i: 

0 

86 

2028 

15 

42: 

D 

1 

2029 

15 

42: 

D 

1 

2030 

15 

42: 

0 

1 

2031 

15 

42: 

0 

0 

2032 

15 

42: 

1 

0 

2033 

15 

42: 

1 

4 

2031 

15 

42: 

1 

8 

2035 

15 

42: 

1 

12 

2036 

15 

42: 

2 

17 

2037 

15 

42: 

3 

17 

2038 

15 

42: 

3 

20 

2039 

15 

42: 

3 

24 

2040 

15 

42; 

3 

28 

2041 

15 

42; 

3 

37 

mode:=rightj; 

COMV|AND  =  COPrc 


DOIT{ (RMARGIN- 
*) 


BEGIN 
ELSE  (* 
BEGIN 

mode:=center; 

d0it( ( (rmargin-lmargin+1)-llength) 

END 


LLENGTH  +  l)-BL/iNKS)  END 


DIV  2-BLANKS+LMARGIN) 


THEM  BEGIN  ERRWAIT;  SHOWCURSOR  END 


END 
ELSE 
IF  CH<>CHR(ETX) 
i:  UNTIL  CH=CHR(ETX)  ; 

direction:=sa\/edir; 

end; 
end; 

FUNCTION  tabby:  INTEGER; 
BEGIN 

IF  REPEATFACTOR  >  0  THEN 
IF  DIRECTION  =  ♦>•  THEN 

TABBY:=8*(REPEATFACT0R-1)+   8-X+0RD(0DD(X)  and  000(248)) 
ELSE 
BEGIN 

IF  X=0  THEN  TABBY:=REPEATFACT0R*8 

ELSE  TABBY:=8*tREPEATFACT0R-l)+X-0R0(0DD{X-l)  AND  000(248)) 

END 

ELSE  tabby:=o 
end; 

procedure  moving! 

VAR 

SAVEX:  INTEGER! 
BEGIN 

IND£LETE:=FALSE! 

inreplace:=false; 

EXITPRoyPT:=FALSE; 

if  infinity  then 

BEGIN 

CASE  COMMAND  OF 

UPfLEFT:  JUMPBEGIN! 
00»»iN, right:  jUMPENDi 

space.advance.tab:  if 

END! 


DIRECTI0N=»<'  THEN  JUMPBEGIN  ELSE  JUMPEND 
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2045 

2046 
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2049 
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2051 

2052 

2053 

2054 

2055 

2056 

2057 

2058 

2059 

2060 

2061 

2062 

2063 

2064 

2065 

2066 

2067 

2068 

2069 

2070 

2071 

2072 

2073 

2074 

2075 

2076 

2077 

2078 

2079 

2080 

2081 

2082 


15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 


42 

42 

42 

42 

42 

42:i 

42:2 

42:2 

42:2 

42:2 

42:2 


42 

42 

42 

42 

42 

42:3 

42:2 

42:4 

42:5 

42:4 

42:5 

42:6 

42:6 

42:& 

42:6 
42:7 
42:8 
42:8 
42:7 
42:5 
42:3 
42:2 
42:2 

42:2 
42:3 
42:4 
42:5 

42:6 
42:5 
42:6 


66 

70 

72 

76 

76 

85 

85 

97 

00 

04 

08 

21 

25 

29 

34 

34 

53 

65 

65 

72 

92 

97 

97 

03 

14 

21 

36 

36 

44 

53 

55 

57 

57 

02 

20 

22 

31 

31 

42 

51 

53 


needprompt:=true; 

NExTCOMMANO; 

exitcmoveit) 

End; 

FINDXY(x.LINE); 
REPEAT 

OLDX:=x;  oldline:=line; 

CASE  COMMAND  OF 
left:  LEFTMOVE; 
right:  rightmovej 

up?^up  ^^   direction='<'  then  leftmove  else  rightmove; 
do^jn:  downmove; 

advance:  LINEMOVE(REPEATFACTOR) ; 

parac: 

IF  repeatfactor>iooo  then  errorctoo  MANySNONFATAL) 

ELSE  LINEM0VE(SCREENHEIGHT*REPEATFACT0R){ 
TA3:  BEGIN 

IF  REPEATFACTOR  >=  4096  THEN 

ERR0R( INTEGER  OVERFLOW tNONFATAL) 
ELSE 

BEGIN 

REPEATFACTOR :=TABBY  I 

IF  DIRECTI0N=»<»  THEN  LEFTMOVE  ELSE  RIGHTMOVE; 

SAVEX:=X+1; 

WHILE  <X<>SAVEX)  AND  (X  MOD  8<>0)  DO 
BEGIN 

SAVEx:=x;  repeatfactor:=i; 

IF  DIRECTI0N=»>»  then  rightmove  ELSE  LEFTMOVE 

END 
END 
END 

end; 

IF  EXITPROMPT  OR  ( COMMAND=PARAC)  THEN  GOTOXY( X.LINE ) 

IF  LINE=0LDLINE  THEN 
BEGIN 

IF  X=0LDX+1  THEN 

GOTOXY(X.LINE)  [KLUDGE  FOR  HAZELTINE  TERMINALS  THAT  USED  DLES: 
ELSE 

IF  X=OLDX-i  THEN  WRITE ( CHR ( BS) ) 
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2033 

15 

42:6 

74 

2084 

15 

42;  4 

85 

2035 

15 

42:3 

as 

2086 

15 

42:4 

87 

2087 

15 

42:5 

96 

2088 

15 

42:6 

96 

2089 

15 

42:6 

15 

2090 

15 

42:7 

29 

2091 

15 

42:5 

43 

2092 

15 

42:4 

43 

2093 

15 

42:5 

45 

2094 

15 

42:2 

54 

2095 

15 

42:2 

57 

2096 

15 

42:i 

57 

2097 

15 

42:i 

71 

2098 

15 

42:i 

79 

2099 

15 

42:o 

82 

2100 

15 

42:o 

04 

2101 

15 

43:d 

1 

2102 

15 

43:d 

3 

2103 

15 

43:d 

3 

2104 

15 

43:d 

4 

2105 

15 

43;o 

0 

2106 

15 

43:i 

0 

2107 

15 

43:i 

3 

2108 

15 

43:2 

8 

2109 

15 

43:3 

8 

2110 

15 

43:4 

16 

2111 

15 

43:5 

16 

2112 

15 

43:5 

27 

2113 

15 

43:5 

37 

2114 

15 

43:6 

46 

2115 

15 

43:5 

54 

2116 

15 

43:4 

55 

2117 

15 

43:3 

59 

2118 

15 

43:4 

61 

2119 

15 

43:2 

77 

2120 

15 

43:0 

79 

2121 

15 

43:0 

94 

2122 

15 

3o:d 

1 

2123 

15 

3o:d 

5 
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ELSE  GOTOXYCX.LINE) 

END 

ELSE 

IF  X=OLDX  THEN 
BEGIN 

IF  LINE=0LULINE+1  THEN  WRITE ( CHRCLF) ) 
ELSE  IF  LINE=0LDLINE-1  THEN  CONTROL( UPCURSOR) 
ELSE  GOTOXY(X,LINE) ; 
END 
ELSE 

GOTOXY(XtLlNE) ; 

repeatfactor:=i; 
nextcommand 

UNTIL  NOT  (COMMAND  IN  CUP tDOWN tLEFT.RlGHTt ADVANCEtSPACEt TABD) 5 

if  exitprompt  then  prompt; 
showcursor; 
end  {*  moving  *) ; 

procedure  putitback(c1»c2:  ptrtype); 

VAR 

PTR:  PTRTYPE; 

INDENT, lOFF:  INTEGER? 
BEGIN 

PTR: =Cl • 

WHILE  PTR<=C2  DO 
BEGIN 

IF  ebuf'^[:ptr:=chr(eol)  then 
besin 
ptr:=ptr+i;  writeln; 
indent:=leadblanks(ptr,loff) ; 
if  (ptr<c2)  and  (indent>0)  then 

writec    ♦:indent); 
ptr:=ptr+loff 

END 
ELSE 

BEGIN  WRITECEBUF'^CPTRJ)  ;  PTR:=PTR  +  1  END; 

end; 

end; 

procedure  clear(*x1,y1»x2,y2:  integer*); 

{*  screen  co-ordinate  (xi, yd  is  assumed  to  be  before  (x2.y2).  this 


ai^'i 

15 

3o;o 

5 

2125 

15 

30:  j 

5 

2126 

15 

3o:o 

5 

2127 

15 

3o:o 

0 

2128 

15 

3o:i 

0 

2129 

15 

3o:i 

5 

2130 

15 

3o:i 

8 

2131 

15 

3o:i 

47 

2132 

15 

3o:i 

71 

2133 

15 

3o:o 

99 

2131+ 

15 

3o:o 

24 

2135 

15 

44:d 

1 

2136 

15 

44:d 

1 

2137 

15 

44:d 

1 

2138 

15 

44:d 

6 

2139 

15 

44:o 

0 

2lfO 

15 

44:i 

0 

2im 

15 

44:i 

10 

2142 

15 

44:i 

20 

21'f3 

15 

44:2 

29 

2144 

15 

44:1 

44 

2145 

15 

^+4:2 

46 

2146 

15 

44:3 

55 

2147 

15 

44:2 

70 

2148 

15 

44:3 

72 

2149 

15 

44;i 

76 

2150 

15 

44:2 

89 

2151 

15 

44:3 

89 

2152 

15 

44:3 

98 

2153 

15 

44:3 

07 

2154 

15 

44:2 

13 

2155 

15 

44:1 

16 

2156 

15 

44:2 

27 

2157 

15 

44:1 

31 

2158 

15 

44:2 

35 

2159 

15 

44:3 

35 

2160 

15 

44:3 

40 

2161 

15 

44:2 

42 

2162 

15 

44:1 

44 

2163 

15 

44:0 

53 

2164 

15 

44  ;o 

66 

PROCEDURE  TAKES  THESE  CO-ORDINATES  AND  CLEARS  (WRITES  BLANKS)  OVER 

THE  SCREEN  BETWEEN  THEM  (INCLUSIVE)   ♦) 
VAR  XX, I:  INTEGER! 
BEGIN 

GOTOXY(XlfYl) ; 

xx:=xi; 

^iT^Vl-lll    iLlKL^'^r  .^^^l^    ^^    ^<^°  ^^^^  ERASETOEOL(XX,I);  XX:=0;  WRiTELN  END 
IF  Y10Y2  THEN  FOR  11=0  TO  X2  DO  WRITE(»  •) 
ELSE  FOR  I:=X1  TO  X2  DO  WRITEC  ») 
END; 

PROCEDURE  RESOLVESCREEN; 
VAR 

X1.X2»Y1»Y2»SAVE:  INTEGER! 
C1,C2:  PTRTYPE; 

BEGIN 

xi:=x;    Yi:=LiNE! 
x2:=oldxj  y2:=oldline; 
if  newdist>dist  then 
BEGIN  ci:=cuRSOR-i;  C2:=oldcursor;  xi:=xi-i  end 

IF  NEWOISKDIST  THEN 

BEGIN  C2:=0LDCURS0R-l;  Cl:=CURSOR;  X2:=X2-1  END 
ELSE 

EXiT(RESOLVESCREEN),' 
IF  (Y1>Y2)  OR  ((Y1=Y2)  AND  (X1>X2))  THEN 
BEGIN 

save:=ci;  ci:=c2;  C2:=save; 
save:=yi;  yi:=y2;  Y2:=save; 
save:=xi;  xi:=x2;  X2:=save 
end; 
IF  abs(newdist)>abs{dist)  then 

CLEAR(Xl,YltX2.Y2) 
ELSE 

BEGIN 

G0T0XY(X1,Y1); 
PUTlTBACK{ClfC2) 

End; 
gotoxy(x.line) 

end; 
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21S5 

15 

45:0 

2166 

15 

45:0 

2167 

15 

45:0 

2168 

15 

45:0 

2169 

15 

45:^ 

2170 

15 

45;d 

2171 

15 

45:0 

8 

2172 

15 

45:o 

0 

2173 

15 

45:i 

0 

2171+ 

15 

45:i 

16 

2175 

15 

45:i 

23 

2176 

15 

'+5:i 

34 

2177 

15 

45:i 

42 

2178 

15 

*f5:i 

49 

2179 

15 

«*5:i 

52 

2180 

15 

'+5:1 

61 

2181 

15 

45:1 

66 

2182 

15 

'+5:2 

66 

2183 

15 

'+5:2 

70 

2164 

15 

1*5:2 

76 

2185 

15 

^5:2 

68 

2186 

15 

'+5:2 

95 

2187 

15 

'+5:2 

04 

2168 

15 

45:2 

21 

2189 

15 

45:3 

32 

2190 

15 

45:4 

32 

2191 

15 

•♦s:*! 

35 

2192 

15 

i+s:*! 

39 

2193 

15 

45:4 

43 

2191 

15 

45:4 

56 

2195 

15 

45:4 

60 

2196 

15 

45:4 

64 

2197 

15 

45:4 

69 

2198 

15 

45:5 

69 

2199 

15 

"+5:6 

69 

2200 

15 

45:7 

74 

2201 

15 

45:6 

74 

2202 

15 

45:7 

79 

2203 

15 

45:6 

82 

2204 

15 

45:5 

04 

2205 

15 

45:4 

06 

176 

PROCEDURE  deleting; 

LABEL  1; 

VAR 

ATBOLf ANCHOR, SAVE:  PTRTYPE; 

ok,at3ot»no'^ove:  boolean; 
startline:  integer; 

BEGIN 

doffscreen:=false;  indelete:=true!  inreplace:=false;  exitprompt:=false; 

anchor:=cursor;  newdist:=o; 

getleading;  at30l:=linestart;  atbot:={cursor=stuffstart) ; 

promptline:=deleteprompt; 

PROMPT;  NEEDPR0MPT:=TRUEJ 

showcursor; 
findxy(xiLine); 
startline:=line; 
repeat 

oldcursor:=cursor; 

dist:=newdist; 

OLDX:=x;  oldline:=line; 

ch:=getch{ 

command :=translatecch a; 

if  command=digit  then  repeatfactor:=getnum  else  repeatfactor:=1! 

IF  command  in  CREVERSEC,.DI6IT«ADVANCE. SPACE]  THEN 
BEGIN 

CASE  command  of 

left:  leftmove; 

right:  rightmove; 

space:  if  direction=»<»  then  leftmove  else  rightmove; 

UP:  upmove; 

down:  downmove; 

advance:  LINEMOVE(REPEATFACTOR); 

reverseciForwardc: 
begin 
IF  command=reversec  then 

direction:=»<» 
else 
direction:=»>» ; 

GOTOXY(0»0);  WRiTEiDlRECTlON) ;  GOTOXY (XiLlNE) 

end; 
tab: 


^'^  SlGIM 


2206  15  45;5 

22?3  11  nil  io  IF  ^EPEATFACT0K>=^a36  THEN  ERROR (• INTEGER  OVFLW , NONFATAL ) 

22Q9  15  ^5:7  55  ^EGlN 

nil  is  IV-l  f?  REpeatfactor:=tabby; 

2212  15  ll'l7  sj  TMH^  DIRECTIOn='<.  THEN  LEFTMOVE  ELSE  RIGHTMQVE 


2213   15    fb:5     52 
^21'+   15    45:4     52 


END 
END 
END; 


mi  i^  IV.'!  t1  newdist:=cursor-anchor; 

5517  ,=  li:^  ^°  resolvescreen; 

2217  15    45:3  92  fND 

2218  15    45:2  92  ELSE 

2220  II         ll'-l  07  ^^    (CH<>CHR(ESC))  AND  (CH<>CHR(  ETX)  )  THEN 

2221  15    4SM  ?I  MM.    ^^^^^    ERRWAIT;  G0T0XY(X,LINE)  END 
PPP5  J^    a=:^  ^^  ^^^^^    <CH  IN  CCHR ( ETX ) , CHR ( ESC ) 3 ) ; 
nil  \l         IV.^  ^^  IF  CH=CHR(ETX)  THEN 

2223  15    45:2  39  BEGIN 

2225  II  IV'i  a!  GETLEADING;  (*  INDENTATION  FIXUP  ♦) 

2226  ll  45-4  UQ  ^^  ^1?°^  ^^°  (CURSORzSTUFFSTART)  THEN 

2227  15  45.*?  tl  r.'^^tl^  CURSOR. =LINESTART;  SAVE:=ANCHOR ;  ANCHOR:=ATBOL  END; 
tiil  ^l  ul'l  .^  ^^  0KT0DEL(CURS0R, ANCHOR)  THEN  .  a  d  l  l.mu. 
22P  ^^  3EGIN 

2230  is  ll'-t  tl  READJUST(MlN(CURSOR,AMCHOR),-ABS(CURSOR-ANCHOR)); 

2231  is  ll'l  on  C0PYLINE:=(CURS0R=LINESTART)  AND  ATBOT; 

iitt  1;l  11:^  ll  IF  anchor<cursor  then 

2233  15  45;5  ll  ^  J0VELEFT(EBUFnCURS0R3,EBUF-CANCH0RD,BUFC0UNT-CURS0R ) 

2235  ll  ll'A  ?q  ,.  "OVELEFT(EBUF-i:ANCHORJ,EBUF-CCURSORa,BUFCOUNT-ANCHOR)  ; 

2236  is  45:^  ll  BUFC0UNT:=BUFC0UNT-ABS(CURS0R-ANCH0R)! 

2237  is  ui'l  fl  CURSOR:=MIn(CURS0R. ANCHOR); 

2238  is  45;4  41  GETLEADING;  CURSOR :=MAX(STUFFSTART, CURSOR ) 

2239  15  45:3  48  ELSE 

ppu?  \l  IV."  ^°  cursor:=save 

2241  15  45:2  50  END 

2242  15  45:1  53  ELSE 

2243  15  4S:2  55  BEGIN 

2245  ll  4six  ll  copyline:=false5  copyok :=true ; 

ttll  ll  ll'.l  ti  COPySTART:=MIN(CURSOR, ANCHOR); 

**  13  4S.3  73  copylength:=abs(cursor-anchor); 


22f7 

15 

45:3 

60 

2248 

15 

45:2 

oi 

2249 

15 

45:1 

63 

225G 

15 

45:1 

67 

2251 

15 

45:1 

9y 

2252 

15 

45:1 

00 

2253 

15 

45:0 

10 

2254 

15 

45:0 

28 

2255 

15 

2a:o 

0 

2256 

15 

23:1 

0 

2257 

15 

2S:2 

5 

2258 

15 

28:i 

5 

2259 

15 

28:2 

9 

2260 

15 

28:3 

14 

2261 

15 

28:2 

18 

2262 

15 

28:o 

22 

2263 

15 

28  :o 

34 

2264 

15 

28  :o 

34 

2265 

15 

28:o 

34 

2266 

15 

28:o 

34 

2266 

15 

28  :o 

34 

2267 

15 

6:d 

1 

2268 

15 

6:d 

1 

2269 

15 

6:d 

1 

2270 

15 

6:d 

4 

2271 

15 

6:0 

10 

2272 

15 

6:d 

12 

2273 

15 

6:d 

13 

2274 

15 

6:0 

14 

2275 

15 

6:d 

15 

2276 

15 

6:d 

16 

2277 

15 

6:0 

44 

2276 

15 

6:d 

46 

2279 

15 

46:o 

1  1 

2280 

15 

46  :o 

0  E 

2281 

15 

46  :i 

0 

2232 

15 

46:i 

7 

2263 

15 

46:2 

14 

2281 

15 

46:3 

14 

2285 

15 

46:3 

23 

2286 

15 

46:3 

23 

CURSOR:=ANCHOR;  i  *' 3 

end; 

i:irjDELErE:=FALS£! 

OK:  =  (LlNL  =  STARTLIigE)    AND    NOT    DOFFSCREErj; 

UPSCREEfjCOK.MOT    OK, LINE)  J 

UEXTCOMmAND; 

EfJD; 

BEGIN 

IF    COMviAND=DELETEC    THEN 

DELETING 
ELSE 

IF    COMMAi\|0=ADJJSTC    THEN 

BEsiN  adjusting;  nextcommand  end 

ELSE  .viOvinG; 
END; 


<*$i  moveit    *) 
{*$i  find     *) 

PROCEDURE  FIND; 
VAR 

THERE f FOUND. LASTPATTERN:  BOOLEAN; 
NEX??PTR^'"p?RiYPEr^"'^^'^^^'^^°''''^^^^^^*'^^   INTEGER; 

mode:  (LITERAL. token*; 
i:  integer; 
delimiter:  char; 
JUSTIN:  boolean; 
PossiBLEtPAT:  ptype; 
usEOLD, verify:  boolean; 

PROCEDURE  NEXTCH; 
BEGIN 

CH:rGETCH; 
IF  CH=CHR(ESC)  THEN 
BEGIN 

IF  NOT  JUSTIN  THEN  REDISPLAY; 

showcursor;  nextcommand; 

EXlT{FIND) ; 


2287   lb    ^6:2  52        END5 

1239   Js    Itll  ^^  ^^    (CH=cHR(EOLn  AND  JUSUN  THEN 

<i*;^iy  15   46:2  41    begin 

I'il^.     ^l       J"^*^  '^^      JUstin:=false; 

2292  15    46:2  46      ENO 

2293  15    4&:i  49    e;lse: 

2294  15    46:2  51      WRITE(CH); 

2295  15    46:o  59  END; 

2296  15  46: 0  72 

ppqI  ^i  ."I*"      ^  PROCEDURE  SKIP; 

2293   15  47:o      0  BEGIN 

2300  is  47;J  12  eND;^""^  ^"^  ^'^  ^  CUR  (  SP)  ,  CHR  (HT)  ,  CHR  (  EOL)  J  DO  NEXTcH 

2301  15  47:o  30 

ilnl       II  IV^  ^    PROCEDURE  OPTIONS; 

2303  15  48:o      0  BEGIN 

2304  15  48:i      0    REPEAT 

pinl  il  11:^  °    ch:=uclc(CH); 

2306   lb  48:2      8      ip  CH=*L»  THEN 

230°!  II  ll\l  II  e:lSe"'  «0D^-=LITERAL;  NEXTCH  END 

2309   15  48:3  21        jp  cH=»V  THEN 

23i?   15  nil  33       else"'  ^ERIFYJxTRUE;  NEXTCH  END 

ll^^i      a  l^'""  ^^  ^^   CH=«T'  THEN 

231       III  II    cH:=ucf^?j::)r^^=^°^^^'  ^"™  ^^^' 

23^1  is  nil  11   enJ;  ^'"=*'*'  °'  ''''-''''   '"^^  useold:=true, 

2319   15  48:o  98 

nil      II  H\°D  3  VAr'^J^I^eIw •"'"""  '*''""=  "'""'  ^*''  ^^=:^""--  INTEGER), 

2322  15  49:0  0  BEGIN 

2323  15  49:1  0    SKIP! 

2325   is  mi  3?    '''b^^jJ'^  '^•^•••*Z%M....z','0»...9.,CHR(BS)3  THEN 

2327   is  IV'I  II  ERR0R( 'INVALID  DELIMITER.  ..NONFATAL)  J 

13  49.3  56        IF  NOT  JUSTIN  THtN  REDlSPLAr; 
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23id8 

15 

49:3 

b5 

24.^9 

15 

49:3 

67 

23iO 

lb 

49:2 

71 

2331 

15 

49:i 

71 

2332 

15 

49:i 

75 

2333 

15 

49:i 

78 

2334 

15 

49:2 

78 

2335 

15 

49:2 

80 

2336 

15 

49:3 

87 

2337 

lb 

49:f 

87 

2338 

15 

49:5 

98 

2339 

15 

4916 

98 

23*10 

15 

49:6 

16 

23'tl 

15 

49:5 

17 

23*f2 

15 

49:4 

21 

2343 

15 

49:3 

27 

23*+ «f 

15 

49:2 

27 

2345 

15 

49:3 

29 

2346 

15 

49:4 

29 

2347 

15 

49:4 

33 

2348 

15 

49:3 

34 

2349 

15 

49:1 

38 

2350 

15 

49:1 

49 

2351 

15 

49:2 

56 

2352 

15 

49:3 

56 

2353 

15 

49:3 

87 

2354 

15 

49:3 

96 

2355 

15 

49:2 

02 

2356 

15 

49:1 

02 

2357 

15 

49:0 

07 

2358 

15 

49:0 

22 

2359 

15 

5o:d 

3 

2360 

15 

5o:d 

4 

2361 

15 

5o:d 

4 

2362 

15 

5o:o 

0 

2363 

15 

5o:i 

0 

2364 

15 

5o:i 

3 

2365 

15 

50  :i 

30 

2366 

15 

5o:o 

37 

2367 

15 

5o:o  , 

52 

2368 

15 

5i:d 

1 

130 

NEXTCOMPfiANO; 

exit(find) ; 
end; 
delimite^:=ch; 
i:=o; 

REPEAT 

nextch; 

if  ch=chr{bs)  then 

BEGIN 

IF  (PATTERNCIDOCHRCEOD)  AND  {I>0)  THEN  (*  DON»T  GO  OVERBOARDI  *) 
BEGIN 

^RITEC  'iCHRCBS))! 

i:=i-i 

END 
ELSE  CONTROL(RIGHTCURSOR) ;  (*  MAKE  UP  FOR  THE  <BS>  NEXTCH  WROTE  OUT  *) 

END 
ELSE 
BEGIN 

patternci3:=ch; 
i:=i+i 

end; 
UNTIL  (CH=DELIMITER)  OR  ( I>=MAXSTRING) ; 
IF  I>=MAXCHAR  THEN 
BEGIN 

error(*your  pattern  is  too  long' i nonfatal) j 
if  not  justin  then  redisplay; 
nextcommand;  exitcfind) 
end; 
plength:=i-15 
07  END  {*  parsestring  *) ; 

function  ok(PTr:  ptrtype):  boolean; 
(*  compare  pat  against  the  buffer  ») 
vAR  I:  Integer; 

BEGIN 

WHILE    (KPLENGTH)    AND    (EBUF^C  PTR  +  I  3=PATC  1 3)    DO    11=1  +  1; 
0K:=    IrpLENGTH; 

end; 
1  procedure  skipkind3(var  cursor:  ptrtype); 


i370 

2371 

2372 

2373 

2371+ 

2375 

2376 

2377 

2378 

2379 

2380 

2381 

2382 

2383 

2384 

2385 

2386 

2387 

2388 

2389 

2390 

2391 

2392 

2393 

239H 

2395 

2396 

2397 

2398 

2399 

2400 

2f01 

2402 

2403 

2404 

2405 

2406 

2407 

2408 

2409 


15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 


5i:o 
51  :o 
5i:i 
5i:2 

51. -2 

5i:o 
5i:a 

52:d 
52:d 
52:d 
52:d 
52:d 

52:  0 

52:i 
52:i 
52:i 
52:i 
52:i 
52:2 
52:3 
52:4 

5213 
52:4 
52:3 
52:4 
52:5 
52:4 
52:3 
52:4 
52:5 
52:5 
52:5 
52:4 
52:2 
52:0 
52:0 

53:d 
53:0 
53:d 
53:d 


0 
0 
0 
0 
19 
31 
44 
58 
1 
1 
1 
1 
2 
0 
0 
3 
7 
17 
32 
40 
40 
49 
67 
71 
77 
85 
85 
88 
92 
94 
94 
10 
30 
45 
51 
53 
70 
1 
1 
1 
1 


BEGIN 

(*  SKIP  OVER  KII\ID3  CHARACTERS  IN  THE  EBUF.   UPDATE  THE  CURSOR 

TO  THE  FIRST  r\10N-KINri3  CHARACTER 
WHILE  EBUF'^CCURSOR:  IM  CCHH(SP),CHR{HT)  ,CHR(DLE)  .CHR(E0L)3 
IF  E3UF'^CCURSQR3=CHR(dLE)  THEN  CURSOR ;  =CURS0R  +  2 
ELSE  CURS0R:=CURS0K+1; 
end; 


DO 


*) 


PROCEDURE  SCANBACKWAROJ 

LABEL  1; 

VAR 

loc:  ptrtype5 
chthere:  boolean; 

BEGIN 

chthere:=true; 
THERE :=false; 

FILLCHaR(PATC0  3,SIZEOF(PAT),»  •); 
MOVELEFT{TARGETCSTART3,PATC0  3«PLENGTH); 
WHILE  CHTHERE  AND  NOT  THERE  DO 
BEGIN 

1:    IF  PTR>=PLENGTH  then  {*  POSSIBLY  THERE  ♦) 

LOC;=SCAN(-PTR»=PATC0:tEBUF'^CPTR3) 
ELSE 

L0C:=-PTR5 
IF  LOC=-PTR  THEN  (♦  NOT  THERE!  ») 
BEGIN 

chthere:=false;  there;=false 

END 
ELSE 
BEGIN 

ptr:=ptr+loc;  next:=ptr-ij 

IF  EBUF'*CPTR-13=CHR(DLE)  then  begin  PTr:=NEXT5  goto  1  END? 

IF  ok(ptr)  then  there:=true  else  ptr:=next 

END 
END? 

end; 

procedure  scanforward; 
label  1; 

VAR 

maxscan.loc:   integer? 


181 


2^+15 

2<416 

2417 

2418 

2fl9 

2420 

2421 

2422 

2423 

2424 

2425 

2426 

2427 

2428 

2429 

2430 

2431 

2432 

2433 

2434 

2435 

2436 

2437 

2438 

2439 

2440 

2441 

2442 

2443 

2444 

2445 

2446 

2447 

2448 

2449 

2450 


15 

15 

15 

lb 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 


o3:d 
b3:o 
53:i 
53:i 
53:i 
53:i 
53:i 
53:2 
53:3 
53:3 
53:4 
53:3 
53:4 

53;3 

53:4 

53:3 
53:4 

53:5 
53:5 
53:5 
53:4 
53:2 
53:0 
53:0 
54:d 
54:d 
55:d 
55:d 
55:0 
55:1 
55:1 
55:1 
55:1 
55:1 
55:0 
55:0 
56:d 
56:q 

56:o 
56:i 
56:i 


6 
0 
0 
3 
7 
17 
32 
40 
40 
53 
58 
73 
77 
BO 
85 
92 
94 
94 
10 
30 
45 
51 
53 
70 
1 
1 
1 
1 
0 
0 
4 
10 
45 
72 
80 
92 
1 
1 
0 
0 
4 


chthere:  boolean; 

BEGIN 

chthere:=true; 
there:=false; 

FILLCHaR(PATC0D»SIZEOF(PAT),»  •)  ! 
M0VELEFT(TARGETC START :,PATC0  3»PLENGTH) ; 
WHILE  CHTHERE  AND  NOT  THERE  DO 
BEGIN 
1:  MaxSCAN:={BUFC0UNT-PLENGTH)-PTR+1; 
IF  MaxSCAN>0  then  (*  STILL  STUFF  TO  SCAN  *) 

LOc:=SCAN(MAXSCAN,=PATC0  3.EBUF''CPTR3) 
ELSE 

loc:=maxscan;  (*  dummy  up  •not  found*  condition 
IF  loc=maxscan  then 
BEGIN  chthere:=false;  there:=false  end 

ELSE 
BEGIN 

ptr:=loc+ptr;  next:=ptr+i; 

IF  EBUF^i:PTR-ia=CHR(DLE)  THEN  BEGIN  PTR:=NEXT; 
IF  OK(PTR)  THEN  THERE:=TRUE  ELSE  PTR:=NEXT 
END 
END! 

end; 

PROCEDURE  GOFORIT; 


±oc. 


*) 


GOTO  1  END; 


nextline; 
nextstart* 


CALCULATE  THE  START  AND  STOP  FOR  THE  NEXT  LINE  *) 


PROCEDURE 
(♦  GIVEN 
BEGIN 

lastpattern:=false; 
start:=nextstart; 

ST0P:=MIN(TLENGTH-1,START+SCAN(TLEN6TH-START,=CHR(E0L),TARGETCSTART3) 
IF  ST0P=TLENGTH-1  then  BEGIN  STOP: =MAX { STOP, 0 ) ;  LASTPATTERN: =TRUE  END 

nextstart:=stop+i; 
end; 


PROCEDURE  NEXTTOKEN; 

(*  GIVEN  nEXTSTART,  CALCULATE 

BEGIN 

lastpattern:=false; 
start:=nextstart; 


start  AND  stop  ♦) 


2455 

2456 

2457 

2458 

2459 

2460 

2461 

2462 

2463 

2464 

2465 

2466 

2467 

2468 

2469 

2470 

2471 

2472 

2473 

2474 

2475 

2476 

2477 

2478 

2479 

2480 

2481 

2482 

2483 

2484 

2485 

2436 

2487 

2488 

2489 

2490 

2491 


15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 


b& 

56 

56 

56 

56 

56 

5612 

56:i 

56:i 
56:i 
56:i 
56:i 
56:i 
56:i 
56:o 
56:o 
54:o 
54: 1 
54:i 
54: 1 

54:2 
54:2 

54:2 
54:2 
54:2 
54:2 
54:3 


54 

54 

54 

54 

54:6 

54:6 

54:6 

54:6 

54:6 

54:6 

54:6 

54:7 

54:6 

54:7 


10 

10 

38 

48 

54 

54 

93 

03 

19 

19 

19 

27 

43 

63 

88 

06 

0 

0 

4 

10 

10 

16 

20 

33 

45 

56 

61 

61 

67 

71 

81 

81 

94 

04 

09 

21 

31 

46 

57 

57 

63 


AND  (STARKTLENGTH-1)  DO 


IF 

end; 


(*  SKIP  OVER  LEADING  KIND3  CHARACTERS  *) 

WHILE  (TARGETCSTART]  IN  CCHR ( SP ) , CHR ( EOL ) f CHR ( NT ) 3 ) 

start:=start+i; 
stop:=start; 

(*  GET  THE  NEXT  TOKEN  ♦) 

WHILE  (KINDCTARGETCSTART3:=KINDCTARGETCST0P+1DD)  AND  (ST0P<TLENGTH-1 )  DO 

STOP:=SToP+i ; 
stop:=min{stop,tlength-i) ; 

(*  TO  ACCURATELY  TEST  FOR  THE  LAST  TOKEN.  SCAN  OFF  THE  TRAILING  KIND3 

nextstart:=stop+i; 

WHILE  (TARGETCNEXTSTART]  IN  CCHR (EOL) ,CHR ( SP) , CHR (HT) D)  AND 
(NEXTSTART<TLENGTH)  DO  MEXTSTART:=NEXTSTART+l; 
NEXTSTARTzTLENGTH  THEN  BEGIN  ST0P:=MAX ( STOP, 0 ) ;  LASTPATTERN:=TRUE 


end; 


BEGIN(*  GOFORIT  *) 

FOUND :=false; 
next:=ptr; 

REPEAT 

PTR:=NEXT;  (*  SET 

nextstart:=o;  <* 


TO  NEXT  PLACE 
FOOL  NEXTLINE 


TO  SCAN  FOR  *) 
INTO  GIVING  US 


IF  MODE=LITERAL  THEN  NEXTlINE  ELSE  NEXTTOKEN; 

plength:=stop-start+i; 

IF  DIRECTI0N=»>»  THEN  SCANFORWARD  ELSE  SCANBACKWARD; 
IF  THERE  THEN 
BEGIN 

couldbe:=ptr; 
found:=true; 

WHILE  (NOT  LASTPATTERN)  AND  FOUND  DO 
BEGIN 

IF  M0DE=LITERAL  THEM 

PTR:=PTR+PLENGTH5 

SKIPKIND3(PTR);  (♦  GO  PAST  THE  JUNK  ON  THE 

PLENGTH:=ST0P-START+1|  <*  for  the  new  LINE 

FILLCHAR{PATC0  3«SIZEQF(PAT)»»  Ml 

MOVELEFT(TARGETCSTART3»PATC0  3,PLENGTH)« 
IF  PTR+PlENGTH  >  BUFCOUNT  THEN 

FOUND:=FALSE 
ELSE 

IF  NOT  OK(PTR)  THEN  F0UND:=FALSE; 


START  AND  STOP  FOR  LINE  1  *) 


NEXTLINE  ELSE  NEXTTOKEN; 


NEXT 
*) 


LINE  ♦) 


183 


184 


2^32 

15 

54, 

;5 

77 

Z^3l 

15 

54 

:3 

79 

2491 

15 

54 

13 

79 

iitgs 

15 

54 

;3 

79 

2«f96 

15 

54 

:2 

79 

2<f97 

15 

54 

15 

05 

2498 

15 

51+! 

■6 

05 

2'+99 

15 

541 

.6 

21 

2500 

15 

54! 

:7 

29 

2501 

15 

541 

6 

56 

2502 

15 

54; 

6 

60 

2503 

15 

54; 

;6 

71 

250«+ 

15 

54; 

!7 

07 

2505 

15 

54; 

;5 

11 

2506 

15 

54; 

;i 

11 

2507 

15 

54; 

.0 

21 

2508 

15 

54; 

0 

38 

2509 

15 

57; 

D 

1 

2510 

15 

57; 

0 

0 

2511 

15 

57; 

.1 

0 

2512 

15 

57; 

.1 

20 

2513 

15 

57; 

1 

28 

25m 

15 

57; 

.1 

51 

2515 

15 

57; 

;i 

64 

2516 

15 

57; 

:i 

04 

2517 

15 

57; 

!0 

13 

2518 

15 

57; 

:o 

26 

2519 

15 

58; 

D 

1 

2520 

15 

58; 

!D 

1 

2521 

15 

58; 

!0 

0 

2522 

15 

58; 

!1 

0 

2523 

15 

58 

\2 

6 

2524 

15 

58 

13 

6 

2525 

15 

58 

:3 

19 

2526 

15 

58 

:3 

72 

2527 

15 

58 

!3 

82 

2528 

15 

58 

13 

85 

2529 

15 

58 

:3 

92 

2530 

15 

58. 

;4 

99 

2531 

15 

58; 

5 

99 

2532 

15 

58; 

5 

11 

THEN 


end; 

end; 
(♦  ih   token  mode  make  sure  the  first  and  last  characters 

OF  THE  TARGET  ARE  ON  'TOKEN  BOUNDARIES'  *) 
IF  MODE=TOKEN  THEN  IF  KINDC PATH 0 D3=0RD ( ' A • )  THEN  IF  FOUND  THEN 
BEGIN 

IF  ((C0ULDBE>2)  AND  (EBUF'*CC0ULDBE-2K>CHR  (OLE)  )  )  OR 
(C0UL0BE<=2)  THEN  (*  WHEW!  *) 
IF  KINQCEBUF'"CC0ULDBE33=KINDCEBUF^CC0ULDBE-1DD  THEN 

found:=false;  (*  false  find...  don'T  count  it.  ♦) 
if  (ptr+plength<=bufc0unt-1)  and 

(KINDCEBUF*CPTR+PLENGTH-133=KINDCEBUF'^CPTR+PLENGTH3  3) 

found:=falsE5  (♦  another  false  find  *) 

END; 

until  found  or  not  there; 
end(*  goforit  *) ; 

PROCEDURE  putprompt(left.right:string;  repeatfactor:integer;  lortiboolean) 
begin 
promptline:=lefT!  prompt; 

WRITE(  'c*); 

IF  INFINITY  then  WRITEC/')  ELSE  WRITE(REPEATFACT0R  )  I 

WRITEC::  '); 

IF  LORT  then  if  M0DE=T0KEN  THEN  WRITE(»L(IT»)  ELSE  WRITE ( ♦T(OK» ) ; 
WRITE(RIGHT) 

end; 

procedure  replaceit; 

LABEL  i; 
BEGIN 

IF  VERIFY  THEN 

BEGIN 

CEntERCURSOR(TRASH.MIDDLE»NOT  JUSTIN) « 

PUTPROMPTC  REPLACE' »»<ESC>  ABORTS,  "R"  REPLACES,  "  "  DOESN"T'« 

repeatfactor-i+2, false) ; 
showcursor; 
ch:=getch; 
IF  ch=chr(Esc)  then 

BEGIN 

getleading;  cursor : =max(cursor, stuffstart) ; 
nextcommand;  exit(find) 


2533 

15 

58:4 

17 

253'+ 

15 

58:3 

17 

2535 

15 

b8:2 

28 

253o 

15 

58:2 

28 

2537 

lb 

b8:i 

28 

2538 

15 

58:2 

37 

2539 

15 

58:3 

54 

25<+0 

15 

58:4 

54 

2541 

15 

58:4 

91 

25^+2 

15 

58:4 

03 

25f3 

15 

58:3 

09 

254if 

15 

58:2 

09 

2545 

15 

58:3 

11 

2546 

15 

58:i 

26 

2547 

15 

58:2 

28 

2548 

15 

58:3 

37 

2549 

15 

58:i 

52 

2550 

15 

58:i 

64 

2551 

15 

58:2 

73 

2552 

15 

58:i 

84 

2553 

15 

58:i 

95 

2554 

15 

58:i 

06 

2555 

15 

56:i 

10 

2556 

15 

58:i 

24 

2557 

15 

6:o 

0 

2558 

15 

611 

0 

2559 

15 

6:i 

3 

2560 

15 

611 

7 

2561 

15 

6:i 

11 

2562 

15 

6:i 

24 

2563 

15 

6:2 

29 

2564 

15 

6:1 

55 

2565 

15 

6:2 

59 

2566 

15 

6:1 

99 

2567 

15 

6:1 

03 

2568 

15 

6:1 

07 

2569 

15 

6:1 

09 

2570 

15 

6:2 

15 

2571 

15 

6:3 

15 

2572 

15 

6:3 

23 

2573 

15 

6:2 

23 

if  (ch<>»rm  and  (cho'km  then  goto  1; 
End; 
(*  Replace  target  with  substring  *) 

IF  slength>cursok-lastpat  then 
if  slength-(cuksor-lastpat)+8ufcount>bufsize-20o  then 

BEGIN 

ERROR( 'BUFFER    FULL.       ABORTING    REPLACE ^NONFATAL) ; 
GETLEADING;    CURS0F?:=MAX(CURSQR,STUFFSTART)  ; 

NEXTCOMMAND;    EXIT(FIND); 
END 
ELSE 

M0VERIGHT(EBUF-CCURS0R3,EBUF-CLASTPAT+SLENGTH3.BUFC0UNT-CURS0R) 

CLoOu 

IF  slength<cursor-lastpat  then 

M0VELEFT(EbUF^CCURS0RD,EBUF-CLASTPAT+SLENGTH3,BUFC0UNT-CURS0R){ 
MOvELEFT(SUBSTRINGC03,EBUF-CLASTPAT3,SLENGTH);  cuhsurj, 

IF  SLENGTHOCURSOR-LASTPAT  THEN 

READJUST(LASTPAT,SLENGTH-(CURS0R-LASTPAT))| 
BUfc0UNT:=BUFC0UNT+SLENGTH-(CURS0R-LASTPAT)J 
CURSOR   :=CURS0R   +SLENGTH-(CURS0R-LASTPAT)} 

justin:=false;  ' 

i:end; 

BEGIN 

justin:=true; 

useold:=false; 

verify:=false; 

IF  pagezero.tokoef  then  mode:=token  else  mode;=literal: 

IF  COMmaNDsFINDC  THEN 

^^putpromptc  fino»»»  <target>    =>srepeatfactor.true) 

needJrSS??[ItrSe;'"'^^*''  ^"''  ^'''''^^  ^^^^^    =>».REpeatfactor,true), 

nextch;  skip; 

options; 

IF  not  USEOLD  THEN 
BEGIN 

PARsESTRING(TarGET,TLENGTH) ; 

tdefined:=true 
end; 


185 


2b7f  15  6:1  11  IF  C0M^1A.^1D=REPLACEC  THEN 

2575  15  6:2  32  BEGIN 

2576  15  6:3  J2  NEXTCH;  SKIP; 

2577  15  5:3  36  USEOLD : =FALSE ; 

257a  15  6:3  ^0  options; 

2579  15  6:3  1+2  IF  mOT  USEOLD  THEN 

2580  15  6:1+  ^8  8EGIN 

2581  15  6:5  48  PARSESTRING(SUBSTRING,SLENGTH) ; 

2582  15  6:5  56  SDEFINED:=TRUE 

2583  15  6:4  56  enD 
2581  15  6:2  60  end; 

2585  15  6:1  60  home; 

2586  15  6:1  63  CLEARHnE<0); 

2587  15  6:1  67  IF  { ( C0MMAND=FINDC )  AND  TDEFINED) 

2588  15  6:1  74  OR  ( (COMMAND=REPLACEC >  AND  SDEFINED  AND  TDEFINED)  THEN 

2589  15  6:2  88  BEGIN 

2590  15  6:3  88  i:=i; 

2591  15  6:3  91  found:=true; 

2592  15  6:3  94  PTr:=CURSQR; 

2593  15  6:3  97  WHILE  ( ( I<=REPEATFACTQR )  OR  INFINITY)  AND  FOUND  DO 

2594  15  614  08  BEGIN 

2595  15  6;5  08  GOFORIT;  (*  FIND  THE  TARGET  (HANDLES  TOKEN  AND  LITERAL  MODE)  *) 

2596  15  6:5  10  i:=l+i; 

2597  15  6:5  15  IF  FOUND  THEN 

2598  15  6:6  18  BEGIN 

2599  15  6:7  18  CURS0R:=PTR+PLENGTH;  LASTPAT:=C0ULDBE;  (*SET  up  for  next  TIME*) 

2600  15  6:7  26  IF  COMMAND=REPLACEC  THEN  REPLACEIT; 

2601  15  6:7  33  IF  DIRECTI0N='<»  THEN  PTR:=C0ULDBE-1  ELSE  PTR:=CURSOR; 

2602  15  6:6  48  END; 

2603  15  6:4  h8  end; 

2604  15  6:3  50  IF  NOT  FOUND  THEN 

2605  15  6:4  54  IF  NOT(  INFINITY  AND  (I>2)  )  THEN 

2606  15  6:5  64  ERROR( 'PATTERN  NOT  IN  THE  FILE' , NONFATAL ) 

2607  15  6:2  91  END 

2608  15  6:1  94  ELSE 

2609  15  6:2  96  ERROR{'NO  OLD  PATTERN, ♦, NONFATAL) ; 

2610  15  6:1  18  CENTERCURS0R(TRASH,MI0DLE»N0T  JUSTIN); 

2611  15  6:1  28  GETLEADING; 

2612  15  6:1  31  CURSOR:=MAX(STUFFSTARTtCURSOR) ; 

2613  15  6:1  40  SHOWCURSOR; 

2614  15  6:1  43  NEXTCOviMAND 


2615 

15 

6:o 

'+3 

iiolo 

15 

6:o 

60 

i6l6 

15 

o  •  u 

tU 

2617 

15 

2:d 

1 

2618 

15 

2:0 

0 

2619 

15 

2:1 

0 

2620 

15 

2:2 

5 

2621 

15 

2:3 

5 

2622 

15 

2:3 

13 

2623 

15 

2:3 

16 

262'+ 

15 

2:3 

20 

2625 

15 

2:2 

20 

2626 

15 

2:1 

26 

2627 

15 

2:1 

30 

2628 

15 

2:0 

38 

2629 

15 

2:0 

50 

2630 

15 

59:d 

1 

2631 

15 

59:0 

0 

2632 

15 

59:1 

0 

2633 

15 

59:1 

4 

263«t 

15 

59:2 

9 

2635 

15 

59;  1 

18 

2636 

15 

5912 

20 

2637 

15 

59:1 

37 

2638 

15 

59:1 

40 

2639 

15 

59;  1 

50 

26(fO 

15 

59:1 

54 

26*+! 

15 

59:1 

58 

2642 

15 

59:1 

62 

2643 

15 

59:1 

66 

2644 

15 

59:1 

70 

2645 

15 

59:1 

74 

2646 

15 

59:1 

78 

2647 

15 

59:1 

82 

2648 

15 

59:1 

84 

2649 

15 

59:1 

88 

2650 

15 

59:1 

92 

2651 

15 

59:1 

96 

2652 

15 

59  ;i 

00 

2653 

15 

59:1 

04 

2654 

15 

59:3 

04 

*) 
*) 

nextcommand; 


CMADE  VARIABLE  FOR  SCREENS  OF  SHORT  WIDTH.  MABD 


EfMO; 
(*$i  FiiMn 

(*SI  USER 
PROCEDURE 

BEGIN 

IF  needprompt  then 

BEGIN 

promptline:=comprompt; 

PROwiPT; 

needprompt:=false; 

showcursor 
end; 
ch:=getch; 
command:=maptocommand(ch)  ; 

END(*  NExtCOMMAND  *) ; 

procedure  COMMANDER; 
BEGIN 

infinity:=false; 

IF  command=slashc  then 

BEGIN  REPEATFACToR:=1; 
ELSE 

IF  C0MMAND=DIGIT  then  REPEATFACTOR;rGETNUM 

case  command  of 
illegal:  begin  errwait;  showcursor;  nextcommand 

REVERSECFORWARDC:    FIXDIRECTIONi 

coPYc:  copy; 

DUMPc:  DUMP; 
FINDC:  FIND; 

iNSERTc:  insertit; 
JUMPc:  jump; 

QUITc:  {  (♦  EXIT  HANDLED  IN  OUTER  BLOCK  *) 

replacec:  find; 
SETCi  setstuff; 
VERIFYC:  VERIFY; 
XECUTEC:  XMACRO; 

ZAPC:  zapit; 
equalc:  begin 
cursor:=lastpat; 


infinity:=true;  nextcommand  end 


else  repeatfactor:=ii 


END; 
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2655 

«i6b6 

2657 

2658 

2659 

2660 

2661 

2662 

2663 

266<^ 

2665 

2666 

2667 

2668 

2669 

2670 

2670 

2671 

2672 

2673 

267«t 

2675 

2676 

2677 

2678 

2679 

2680 

2681 

2682 

2683 

2684 

2685 

2636 

2687 

2688 

2689 

2690 

2691 

2692 

2b93 

2694 


15 

lb 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


031-6 

59:3 

59:3 

59:3 

59:2 

59:1 

59:1 

59:0 

59:0 

1:0 

1:1 

li 


1 
0 
0 
0 
0 
0 


1: 

1: 

1: 

1: 

1: 

12:d 

12:0 

12:1 

12:0 

12:0 

13:d 

i3:o 

13:1 

13:0 

i3:o 

4:d 

1:0 

4:0 

4:1 

f  :i 

4:1 

4:0 

4:0 

16:d 

i6:o 

i6:i 

16:2 

16:3 

16:3 


U7        GETLEADINb; 

10      cursor:=max(Cursor,stuffstart) ; 

19        CEnTERCURSORCTRASH, MIDDLE. FALSE) ; 

29      showcuhsor;  nextcommand 
32    end; 

36  AD JUSTCDELETEC, PAR AC, UP. DOWN .LEFT. RIGHT, ADVANCE, TAB. space:  MOVE IT 

36  END  (*  BIG  LONG  CASE  STATEMENT  *); 

04  END  (*  COMMANDER  *) ; 
18 

0  BEGIN  (*  eDITCORE  *) 

0  NEXTCOMMANO; 

2  WHILE  COMMANDOQUITC  DO  COMMANDER 

7  END! 
26 

26 

26  (♦$!  USER       *) 

26  (♦$!  MISC       *) 

3  FUNCTION  MlN(*  ( A, B: INTEGER )! INTEGER  *); 
0  BEGIN 

0   if  a<b  then  min:=a  else  min:=b 
10  end; 

26 
3  FUNCTION  MAX  {*( A.B: INTEGER) I  INTEGER* ) ; 
0  BEGIN 

0   if  a>b  then  max:=a  else  max:=3 
10  end; 

26 

3  FUNCTION  getch(*:char*) ; 
3  var  gch:  char; 

0  BEGIN 

0  REAO(KEYBOARD.GCH) ; 

8  IF  EOLN(KEYBOARD)  THEN  GCH : =CHR ( EOL ) ; 

21   getch:=gch; 
24  end; 

36 

1  PROCEDURE  C0NTR0L(*{WHAT:  SCREENCOMMAND) *) ; 
0  BEGIN 

0   with  Screen  do 

0      BEGIN 

0        IF  HASPREFIXCWHAT3  THEN  WRITE ( PREFIX ) ; 
20        WRITE(CHCWHAT3) ; 
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269b 

2696 

2697 

2693 

2699 

2700 

2701 

2702 

2703 

2704 

2705 

2706 

2707 

2708 

2709 

2710 

2711 

2712 

2713 

27m 

2715 
2716 
2717 
2718 
2719 
2720 
2721 
2722 
2723 

272*+ 

2725 

2726 

2727 

2728 

2729 

2730 

2731 

2732 

2733 

2734 

2735 


1 
1 
1 
1 
1 
1 
1 


16:3 
16:2 
i6;o 
i6:o 

14  :u 
i4:a 
i4:i 

1410 

i4:o 

15  :d 
i5:o 
i5:i 
i5:o 
i5:o 
33:d 
33  :d 
33:d 
33:o 
33  :i 
33:2 
33:3 

33:4 

33:5 
33:5 
33:4 
33:3 

33:4 
33:3 

3313 
33:3 
33:4 
33:3 
33:2 
33:0 
33:0 

8:d 
8:d 
8:d 
6:0 
8:1 
8:2 


'1      E^f ''"'■'''''  ''°  '''''    '^^  ^^°^'^«  TERMINALS  CAN  KEEP  UP<..M.  BERNARDS 

41  END; 

54 

0  begin"^  screenhas(*(what:  screencommand) :  boolean*); 
Q  ^,„^^'^^^^^^'^s:=screen,chcwhatk>chr(0); 

22 

0  BEGIN^°^  haskey(*(what:  keycommand):  boolean*); 
2  ,„|:;^skey:=keybrd.chcwhat3  0  chr(o); 

"  END ; 

5    prefixread:  boolean; 

0  BEGIN 

0    WITH  KEYBRD  DO 
BEGIN 

^'"bcI^Sm^'''^^''^^^  '^^^    (PREFIX  O  CHR(O))  THEN 
oLGIN 

prefixread:=true; 

READ(KEYBOARDtKCH)} 
END 
ELSE 

pRefixread:=false; 
whatitis:=backspacekey; 

WHILE    (WHATITIS    <>    NOTLEGAL)    AND    NOT( (CMC WHATITISI-Krm    Awn 

WM.    !!;f"^RE:AD=HASPREFlXCWHATITIs5    )    dS  ""^^'''    '"'° 

WHATITIS:=SUCC(WHATITIS); 

mapcrtcommand:=whatitis; 

END; 

69  end; 

84 

4  ^il'^^jjoij  maptocommand(*  (ch:char):  commands  *); 

'  iA%^°c%SrKE?c'^MMlND'.''''°'  ''''    ''    '""''''^    '^^    ^'^    ^^^BOARD  RECORD  *, 
0  BEGIN 

1?    I''<CH=KEYBRD. PREFIX)  AND  (CHOCHRO))  THEN 
■*•*      BEGIN 


0 
0 
14 
14 
17 
24 
24 
26 
29 
52 
43 
59 
66 
69 


189 


190 


2736 
2737 
274B 
2759 
2710 
27'+! 
2712 
2713 
2711 
2715 
2716 
2717 
2718 
2719 
2750 
2751 
2752 
2753 
2751 
2755 
2756 
2757 
2758 
2759 
2760 
2761 
2762 
2763 
2761 
2765 
2766 
2767 
2768 
2769 
2770 
2771 
2772 
2773 
2771 
2775 
2776 


a; 
d: 
a; 
8; 
8; 

81 
8! 

8; 


8:2 

8:1 

8:2 

&:o 

8:0 

9:d 

9:0 

9:1 

9:0 

9:0 

io:q 

10:0 

10:1 

10:1 

10:1 

10:1 

10:1 

10:0 

iq:o 

5:d 

5:d 

5:0 

5:1 

5:2 

5:1 

5:2 

5:3 

5:3 

5:2 

5:0 

5:0 

7:d 

7:d 


11 

19 

27 

50 

35 

10 

15 

lb 

66 

66 

68 

71 

90 

3 

0 

0 

31 

16 

1 

0 

0 

6 

11 

17 

20 

30 

12 

1 

1 

0 

0 

7 

a 

12 
12 
11 

16 

18 

30 

1 

2 


kcvd:=mapcrtcoiwmand(Ch)  ; 

IF  KCMO  IN  CUPKtY..RlGHTK£YD 
CASE  KCMD  OF 


THEN 


MAPT0C0MMAN3:=UP; 
ItfiAPTOCUMMAND : =DOWN ; 

maptocommand:=left; 
maptoc;ommanq:=right 


upkey: 

DOlfllNKEY: 

leftkey: 
rightkey 

END 
END 
ELSE 

maptocommand:=translatecchd 
end; 

function  uclc(*(ch:chak) :char*) ;  (*  map  lower  case  to  upper  case  ♦> 

BEGIN 

if  ch  in  c»a»..*2»3  then  uclc :=chr ( ord(ch) -32)  else  uclc:=ch 
end; 

procedure  prompt; 

BEGIN 

promptlineci3:=direction; 
savetop:=promptline; 
control(whome) ; 
clearlinE{0) ; 

WRITE(PROMPTLINE) 

end; 

procedure  clearscreen; 
var  i:integer; 

BEGIN 

IF  screenhas(clearscn)  then 

CONTROL(CLEARSCN) 

else 

BEGIN 

honie; 

ERasEOS(O.O) 

end; 
end; 

procedure  clearline(*y:integer*) ; 
var  I:  Integer; 


f'l'^          1  7:0               0    BEGIN 

V-Tjl          \  l\\               I          IF-    SCREENHASCCLEARLNE)     THEN 

2780    i  I'A               8    ,J°^^^°^fCLEARLNE) 

27^3    1'  7:1     ^^        GOroXY(0,Y); 

J  ^;^     ^I      ^^-.SETOEOUO.n 

^785    1  7:0     21  end; 

f786    1  7:0     34 

?7ftl    1^  J3*°      ^  PROCEDURE  PUTMSG; 

^788    1  l7:o      0  BEGIN 

279n    \  \V\\               °    CONTROl(WHQME); 

2792  \  W^          ^       savetop:=msg; 

279^  1  \l\^            ^'^    WRITE(MSG); 

2793  1  17:0     2tf  end; 

279*+  1  17:0     36 

ViVL  \  W'^              ^  PROCEDURE  HOME; 

2796  1  18:o      0  BEGIN 

2798  \  ia-P      ;    IP  SCREENHAS(WHOME)  THEN 

27^%  i  18';i      I    ^JONTROL(WHOME, 

f^l\  \  W^l  ''      GOTOXY(0,0,; 

2801  1  18:o  17  END; 

2802  1  18:o  30 

2805  1  3:0      0  BEGIN 

2807  \  VA              8    ^^  SCREENHAS(ERASEEOL)  THEN  CONTROL (ERaSEEOL) 

2IS9  \  xi'  ^^       ^'"N 

2810  1  s!"  2I       E[.r^U^T?wpTTro'«r\.T''  ^'^I^WRITE{2.BLANKAREA.SCREENWIDTH-X) 

2811  1  3:3  45       |^!^.!;!'^J\";J,I^<2.BLANKAREA,SCREENWIDTH-X+1);         ^NWIDTHX) 

pftVf  \  i\^  ^°    ^wd; 

-=013  1  3:0  50  END; 

28m  1  3:0  62 

2816  1  sSio      J  PROCEDURE  BLANKCRT(*y:  INTEGERS), 


2817    1    20:1      0 


IF  SCREENHAS(ERASEE0S,  then  BEGIN  GOTOXY(0,Y);  CONTROL(ERASEEOS)  END 

191 


.192 


2818 
2819 
2820 
2321 
2822 
282i 
282^^ 
2825 
2826 
2827 
2828 
2829 
2830 
2831 
2832 
2833 
283H 
2835 
2836 
2837 
2838 
2839 
2810 
2841 
2842 
2a'+3 
2844 
2845 
2846 
2847 
2848 
2849 
2850 
2851 
2852 
2853 
2854 
2355 
2856 
2357 
2858 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


20 
20 
20: 

20; 

20: 

2o: 

20: 

20: 

20 

20 

2o: 

20: 

20 

6; 
6; 
6; 
6: 
6: 
6: 
6; 
6; 

6! 

6: 

61 

&; 

6 


i9:o 


19: 

19! 

19; 
19; 
19; 

19; 

2: 
2; 
2; 
2; 
2; 
2; 
2; 

2 


15 

17 

22 

'12 

24 

40 

40 

42 

42 

47 

51 

51 

64 

1 

3 

0 

0 

7 

8 

12 

12 

16 

45 

50 

50 

64 

1 

0 

0 

8 

10 

22 

22 

1 

0 

0 

8 

13 

:.4 
:.8 

23 


ELSE 

IF  "i-i    THEN 
BESIN 

CLEARSCKEEN; 
^RITELN(SAVETOP) 
END 
ELSE 
BEGIN 

SOTOXY(0»Y) ; 
ERASEOS(O.Y); 

end; 
end; 

procedure  eraseos(*x,llne*) ; 

\/AR    I:     I;n|TEGER; 
BEGIN 

IF    SCREENHAS(ERASEE05>)    THEN 
CONTROL(ERASEEOS) 

ELSE 

BEGIN 

ERASET0E0L(X,LINE) ; 

FOR  i:=LINE+l  TO  SCREENHEIGHT  DO  BEGIN  WRITELN;  CLEARLlNEtl)  END; 

g0toxy(x,line) ; 
end; 
end; 

PROCEDURE  ERRWAIT; 
BEGIN 

write(chR(bell)) ; 

PROMPT; 

end; 


PROCEDURE  error(*s:  STRING ; -iowbad:  errortype*); 

BEGIN 

unitcleaR(I);  (*  throw  away  all  characters  queued  up  *) 
IF  howbad=fatal  then 

BLANkCRT(I) 

else 

begin  home;  clearllne(o)  end; 
write:  ( 'ERROR:  '»S)j 


nil  \            2.1  49    IF  H0W3A0=FATAL  THEN 

2361  X     2:1  53    ELSE 

23o2  1     2:2  ~0      3EGIN 

2864  i     V'l  oe        ^^I^^l'   PLEASE  PRESS  <SPACEBAR>  TO  CONTINUE..); 

2865  i     2^2  16      TMnP^''^  ^""^^^    GETCH='  •;  NEEOPROMPT :  =TRUE 

^^'°^  1    i^:u  20  END; 

2867  1     2:0  i4  {*$I  MISC       *) 

2fa67  1     2:0  54  (*$i  ujjl       ^, 

iB6.  i    ^              I    ^'^SN^ENTR^r'^'''"''^*  '''''''    '''''''^'    ''^    S^^"-  INTEGER):  INTEGER  *,; 

Tail  i    'IId      5     ON  ^JJ^:°I^"^S  TO  THE  BEGINNING  OF  A  LINE 

'b73  I         li\^              I                    BnEs''HAs'?HE'nPFj?T  rM?f  ?  ''    "-^'^'^^    ^^"^^^    ^^    THAT  LINE. 

2374  1    21:d      5  VAR      ^       ^^^  ^^"^^^^  ^^^^  ^^^  ^^^^  O*"  ^HE  FIRST  NON-BLANK  CHARACTER  *) 

nil  J    SJ:"^     ^    OLDPTR:  ptrtype; 

pft77  1   o^•°    ^   INDENT:  integer; 

2877  1    21:0      0  BEGIN 

2879  }      fjij    0   oloptr:=ptr;  indent:=o; 

2880  1    llll  22    ^"^LE^ORD(EBUF-CPTRD)  IN  CHT,SP,DLED  DO 

2^82  J    IV'l  In                    ^^    EaUF-CPTR3=CHR(DLE)  THEN 

2883  1    Siis  45       ELsf  ^"^  PTR:=PTR  +  1;  INDENT:  =  INDENT40RD(EBUF-CPTR  3) -32  END 

atfs  I      llll  II                 if^ord(ebuf-cptrd)=sp  then  inoent:=indent+i 

2887  I         llll  ll  PTR.-p?R:i  ^^°E:NT:  =  (  (INDENT  DIV  8).l,,8;   (*  KLUDGE  FOR  COLUMNAR  TAB!  *) 

2888  i         21:2  72  end;     ' 

nil  ,'         iV.i  ^'^         BYTES:=pTR-OLDPTR; 

?Hqi  ,         1:^  ^^         1-EADBLANKS:=INDENT; 

mi  J    oJ:°  ®^  END(*LEADBLANKS*); 

2892  1    21:0  00 

2894  t    iJin  ^  PROCEDURE  REDISPLAY; 

2895  i    llfo  I     **  OuV^'A°TE^F'L?NloSUpSCR^FN'^'A.  T'    '''''    '^''    "°^  ^^  PARTIALLY  A 
IU't  I         ii:?  ]            CAL\i5^\\?%R'J.'^°E'N^E'RcSRS0R  IT    '''''''    ''    ''''''       ''''    '^''^'''^    '^ 
2898  1    li;o  1    LINEDlST.EOLDIST,LINE:  INTEGER; 


2899 

ii:o 

4 

2900 

ii:a 

b 

i901 

ii:o 

0 

2902 

ii:i 

0 

2903 

ii:i 

3 

«i904 

ii:i 

6 

2905 

ii:i 

11 

2906 

11:2 

11 

2907 

11:2 

25 

2908 

11:2 

30 

2909 

11:2 

35 

2910 

11:2 

48 

2911 

11:2 

65 

2912 

11:2 

74 

2913 

11:3 

84 

2914 

11:2 

96 

2915 

11:2 

06 

2916 

11:1 

14 

2917 

11:0 

24 

2916 

11:0 

42 

2919 

i:d 

1 

2920 

22:d 

4 

2921 

22:d 

4 

2922 

22:d 

4 

2923 

22:d 

4 

292H 

22:d 

4 

2925 

22:d 

4 

2926 

22:0 

4 

2927 

22:d 

5 

2928 

22:0 

0 

2929 

22:1 

0 

2930 

22:1 

18 

2931 

22:1 

21 

2932 

22:2 

21 

2933 

22:2 

26 

2934 

22:2 

42 

2935 

22:2 

48 

2936 

22:1 

57 

2937 

22:1 

78 

2938 

22:2 

34 

2939 

22:1 

95 

^94 

ptr:  ptrtype; 

t:  packed  array  co,.maxsw]  of  char; 

BEGIN 

BLANKCRT(l) ; 

LlfJE:=i; 
ptr:=lineiptr; 

REPEAT 

3lanks:=min(leadblanks(ptr,3ytes) tscreenwidth) ; 
gotoxy(blanks.line) ; 
ptr;=pTr+bytes; 

eoldist:=scan(maxchar,=chr(eol)  »ebuf'*cptr3); 
lineoist:=max(o,min(eoldist,screenwidth-blanks+i) ) ; 

MOVElEFT(EBUF'^CPTR3iTC0D»LIMEOIST)  ; 

IF  E3UF'*[PTR  +  LINEDIST3<>CHR(E0L)  THEN  (*  LINE  TRUNCATION  *) 
TC^AX(0,LINEDIST-1)3:='!'; 

write(T:linedist) ; 
ptr:=ptr+eoldist+i?  line:=line+i 

UNTIL  {LINE>SCREENHEIGHT)  OR  (PTR>=BUFCOUNT ) 

END! 

PROCEDURE  CENTERCURSOR 

(*VAR  line:  INTEGER!  LINESUP:  INTEGER!  NEWSCREEN:  BOOLEAN*)! 

(♦  FIGURE  OUT  IF  THE  CURSOR  IS  STILL  ON  THE  SCREEN.   IF  IT  ISf  AND 

NEWSCREEN  IS  FALSE*  THEN  NO  REDISPLAY  IS  DONE,   OTHERWISE  AN  ATTEMPT 
IS  MADE  TO  POSITION  THE  CURSOR  AT  LINE  "LINESUP".   LINE  IS  THEN  UPDATED 
TO  THE  ACTUAL  LINE  THE  CURSOR  WAS  FORCED  TO.  *) 
VAR 

mark:  INTEGER! 
ptr:  PTRTYPE! 
BEGIN 

IF  EBUF'*CCURS0R:=CHR(E0L)  THEN  PTR:=CURS0R  ELSE  PTR:=CURS0R  +  1  i 

LINE:=0i 
REPEAT 

PTR  '  ~pTR- 1 ' 

ptr:=scan(-maxchar»=chR(Eol)  ,ebuf*[:ptrd)+ptri 

line:=line+1! 

IF  line=linesup  then  MARK:=PTR! 

UNTIL  (LINE>SCREENHEIGHT>  OR  ( ( LINE1PTR=PTR+1 )  AND  NOT  NEWSCREEN)  OR  (PTR<1) 
IF  LINE>SCREENHEIGHT  THEN  (*  OFF  THE  SCREEN  *) 

BEGIN  LINE1PTR:=MARK+1!  REDISPLAY!  LINE:=LINESUP  END 
ELSE 


2940 

29^+2 

291+3 

29'+'+ 

2945 

29'+6 

2947 

2948 

2949 

2950 

2951 

2952 

2953 

2954 

2955 

2956 

2957 

2958 

2959 

2960 

2961 

2962 

2963 

2964 

2965 

2966 

2967 

2966 

2969 

2970 

2971 

2972 

2973 

2974 

2975 

2976 

2977 

2978 

2979 

2980 


1 
1 
1 
1 


22:2 
22:5 
22:4 
22:3 
22:2 


22: 

22; 
22; 
22; 


22:0 

23:d 

23:d 

23:d 

23:q 

23:o 

23:o 

23:d 

23:i 

23:1 

23:i 

23:i 

23:2 

23:3 

23:3 

23:2 
23:2 
23:i 
23:i 
23:1 
23:0 

23  :o 
24:d 
24:d 

24. "D 

24:o 
24: 1 
24:i 

24:o 
24:o 

25:d 
25:d 


97 
06 
06 
u9 

11 

13 
13 
17 


if  linl1ptr=ptr+1   then 
begim 
if  netwscreen  then  redisplay 

END 
ELSE 
BEGIN 

lineiptr:=i;  redisplay 

end; 


19  end; 
34 

1  PROCEDURE  FINDXY(*VAR  INDENT, LINE:  INTEGER*); 
3  \/AR 

i   itLEAD:  integer; 
5   ptr.eolptr:  ptrtype; 
0  begin 

°    "  T^1^e"JgICAL°?UR^oJ"^?"''"  "    '"'   '"""'°'   CORRESPONO.NS 

line:=i; 
ptr:=lineiptr; 

E:0LPTR:=SCAN(MAXCHAR.=CHR(E0L)  ,EBUF-CPTR3)+PTR: 

while  eolptr<cursor  do 
begin 
line:=line+i;  ptr:=eolptr+i;  (*  set  up  for  the  next  line  *> 

^  E0LPTR:=SCAN(MAXCHAR,=CHR(E0L).EBUF-CPTR3)+PTR 

(*  NOW  FIND  THE  INDENTATION  ON  THAT  LINE  OF  THE  CURSOR  *) 
LEAD:=leADBLANKS(PtR.I);  v.uKiUK  «) 

INDENT:=MIN(SCREENWIDTH,{LEAD-I)+(CURS0R-PTR)); 
79  end;(*  findxy  ♦)         ^*  '"'^'^  ^''*^"^  *  ^°''""  ^^'^^  ^^^^^   *' 

94 

1  PROCEDURE  SHOWCURSOR; 
1  VAR 

1   x,y:  Integer; 

0  BEGIN 

0    FINDXY(x,Y)? 

6    GOTOXY{X.Y) 

11  END{*  SHOWCURSOR  ♦)  ; 
24 

3  FUNCTION  GETNUM{*:iNTEeER*); 
3  VAR 


0 

0 

3 

8 

23 

28 

28 

39 

50 

56 

56 

65 

79 


19^ 


^9Fi 


2981 

2982 

2983 

2984 

2985 

2986 

2987 

2988 

2989 

2990 

2991 

2992 

2993 

2994 

2995 

2996 

2997 

2998 

2999 

3000 

3001 

3002 

3003 

3001 

3005 

3006 

3007 

3008 

3009 

3010 

3011 

3012 

3013 

3om 

3015 
3016 
3017 
3018 
3019 
3020 
3021 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

X 

1 

1 


25:d 

2b:D 

25:o 
25:i 
25:i 
25:i 
25:i 

25:2 

2b:3 

2b:3 
25:4 
25:5 
25:5 
25:4 
25:2 

25:i 

25:2 
25:3 
25:3 
25:2 

25:i 

25:2 

25:i 

25  :o 
25:o 
26:d 

26  :o 
26: 
26: 
26; 
26: 
26: 
26: 
26  :i 
26:i 
26:i 
26:i 
26:i 
26:o 

26:o 

27:d 


0 
0 
0 
0 
0 
0 


3 

4 
0 
0 
6 
6 
23 
d8 
28 
35 
40 
40 
49 
49 
55 
73 
76 
76 
03 
06 
06 
08 
11 
18 
32 
1 
0 
0 
0 
0 
0 
0 
0 
0 
3 
16 
34 
43 
44 
60 
3 


n:  integer; 

overflow:  BOOLEAN! 
BEGIN 

n:=o; 
overflow:=false; 

IF  NOT  (CH  IN  CO',. '9':)  THEM  N:=1 
ELSE 

REPEAT 

IF  N  >  1000  THEN  OVERFLOW : =TRUE 
ELSE 
BEGIN 

n:=n*io+ord{ch)-ord( »o' ) j 
ch:=getch 

END 
UNTIL  (NOT  (CH  IN  C»0»..»9»3))  OR  OVERFLOW; 
IF  OVERFLOW  THEN 
BEGIN 

error( •repeatfactor  >  10 t 000 » ♦nonfatal) ; 
getnum:=o; 

END 
ELSE 

getnum:=n; 

COMMAND :=MAPT0C0MMAND(CH) 

end; 


{*  TAKES  CH  AND  MAPS  IT  TO  A  COMMAND  ♦) 


PROCEDURE  GETLEADING; 
BEGIN 

(*  sets: 

linestart  a  pointer  to  the  beginning  of  the  line 

stuffstart  a  pointer  to  the  beginning  of  the  text  on  the  line 

bytes  the  number  of  bytes  between  linestart  and 

stuffstart 
blanks  the  indentation  of  the  line   ♦) 

linestart:=cursor; 

if  ebuf'^clinestartd  =  chr{eol)  then  linestart:=llnestart-l ;  (*  for  scan!  *) 

linestart  :=scan(-maxcharf=chr{eol)tebuf'*clinestartd)+linestart  +  i; 

blanks :=leadblanks( linestart* bytes) ; 

stuffstart :=l i nestart+bytes 
end  {*  getleading  *) ; 

FUNCTION  OKTODEL  (*  ( CURSOR t ANCHOR:  PTRTYPE) :B00LEAN  *)  ; 


iL)22 

1    27:o 

0 

6026 

1   27:i 

0 

3024 

1    27:2 

12 

302b 

1    27:3 

12 

3026 

1    27:3 

lb 

3027 

1    27:3 

95 

3028 

1    27:3 

97 

3029 

1   27:2 

17 

5030 

1   27:i 

17 

3031 

1   27:2 

19 

3032 

1   27:2 

19 

3033 

1    27:3 

19 

SOS*! 

1    27:3 

30 

3035 

1   27:3 

40 

3036 

1   27:3 

58 

3037 

1   27:2 

58 

3038 

1   27:o 

61 

3039 

1    27: 0 

74 

30tfO 

I   27:0 

74 

3om 

I   28:d 

1 

30f2 

I   28:d 

5 

30H3 

L   28:o 

5 

30f<+ 

L   28  :d 

5 

30f5    : 

L   28:d 

7 

3016    ] 

L   28:o 

0 

30^7    j 

L    28:i 

0 

3048    ] 

28:i 

5 

3049    ] 

28:i 

11 

3050    3 

28:i 

25 

3051    ] 

28:i 

42 

3052    1 

2811 

52 

3053    1 

28:2 

63 

3054    1 

28:3 

63 

3055    1 

28:3 

71 

3056    1 

28:2 

78 

3057    1 

28  :i 

78 

3058    1 

28:i 

88 

3059    1 

28:o 

93 

3060    1 

28:o 

08 

3061    1 

29  :d 

1 

3062    1 

29:o 

4 

THEN 
YOU  WISH  TO  DELETE  ANYWAY?  (Y/N)»5 

ELSE  oktodel:=false; 


BEGIN 

IF    ABS(CURSOR-ANCHOR)>(8UFSlZE-3UFCaUf\lT)+10 

BEGIN 

msg:  = 
♦there  is  no  room  to  copy  the  deletion.  do 

PUTMSG; 

IF  UCLC(GETCH)=«Y»  THEN  0KT0DEL:=TRUE 
END 
ELSE 
BEGIN 

(*  COPYLINE  IS  SET  BY  THE  CALLER  *) 

copyok:=true;  copylength:=abs{cursor-anchor) 5 
copystart:=bufsi^e-copylength+i; 

MOvELEFT(EBUF^CMIN  (CURSOR  I  ANCHOR)  3,  EBUF'^CCOPYSTARTDtCOPYLENGTH); 
END? 

end; 

^*°WR?TE^  '-iNE0UT(*VAR  ptr:ptrtype;  bytes, blanks, line:integer*); 

VAR 

linedistiEoldist:  integer; 
t:  packed  array  co,.maxsw3  of  char; 
begin 

gotoxy<blanks.line); 
ptr:sptr+bytes; 

EOLDISt:=SCAN(MAXCHAR»=CHR{EOL)  ,EBUF''CPTR3)  ; 
LINEDIst:=MAX{0»MIN(EOLDIST.SCREENWIDTH-BLANKS+1) ) } 
MQVELEFT(EBUF'^CPTR3,TC0  3fLlNEDIST); 

IF   EBUF-CPTR+LINEDISTK>CHR(EOL)    THEN    (*    LINE    TRUNCATION   *) 
BEGIN 

linedist:=max(linedist»i) ; 
tclinedist-id:  =  »m; 
end; 

WRITE(T:LINEDIST) ; 
PTR:=PTR+E0LDIST+1 
END; 

PROCEDURE  UPSCREEN(*FIRSTLINE,WH0LESCREEN:  boolean;  line:  INTEGER*!; 

(*  ZAP,  INSERT  AND  DELETE  CALL  THIS  PROCEDURE  TO  UPDATE  (POSSIBLY  PARTIALLY) 
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igp 


3063 

3064 

3065 

3066 

3067 

3068 

3069 

3070 

3071 

3072 

3073 

3074 

3075 

3076 

3077 

3078 

3079 

3080 

3081 

3082 

3083 

308f 

3085 

3086 

3087 

3088 

3089 

3090 

3091 

3092 

3093 

3094 

3095 

3096 

3097 

3098 

3099 

3100 

3101 

3102 

3103 


29:d 
29:o 
29:j 
29: 'J 
29:o 
29:o 
29:d 
29:o 
29:i 

29:2 
29:3 
29:3 
29:3 
29:2 

29:i 

29:2 
29:3 
29:2 

29:3 

29:4 

29;4 
29:4 
29:4 
29:5 
29:5 
29:5 
29:4 
29:3 

29:o 
29:o 
3o:d 
3o:d 
3o:d 
3o:d 
30  :d 
3o:o 
3o:i 

30:2 

30:3 
30  :i 
30:2 


4 
4 
4 
4 
4 
4 
5 
0 
0 
3 
3 
5 
14 
19 
21 
23 
26 
33 
37 
37 
46 
48 
51 
51 
65 
72 
73 
83 
86 
00 
1 
3 
3 
3 
3 
0 
0 
0 
15 
54 
67 


THE  SCREEN.   FIRSTLINE  MEANS  ONLY  THE  LINE  THAT  THE  CURSOR  IS  ON  NEED 

BE  UPDATED.   ifllHOLESCREEN  MEANS  THAT  EVERYTHING  MUST  BE  UPDATED.  IF 

NEITHER  OF  THESE  IS  TRUE  THEN  ONLY  THE  PART  OF  THE  SCREEN  THAT'S  AFTER 
THE  CURSOR  IS  UPOaTEO  *) 


VAR 
PTR 


PTRTYPE; 


THE  LINE  ♦) 
THIS  LINE  *> 


BEGIN  (♦  UPSCREEN  *) 
IF  FIRSTLINE  THEN 
BEGIN 

getleading; 

GOTOXY(OtLINE) ;  LRASETOEOL ( 0 . LINE) ;  (♦  CLEAN 
LINEOUT{LINESTaRT»BYTES,BLANKS»LINE)  (*  JUST 
END 
ELSE 

IF  WHOLESCREEN  THEN 

CEnTERCURS0R( TRASH, MIDDLE. TRUE) 
ELSE  (*  ONLY  UPDATE  THE  PART  OF  THE  SCREEN  AFTER  THE  CURSOR  *) 
BEGIN 

GOTOXY(OfLlNE) »  ERASEOS ( 0 ,LINE) ; 

getleading; 
ptr:=linestart5 

REPEAT 

BLANKS:=MIn(LEADBLANKS{PTR, BYTES) fSCREENHIDTH) ; 

LINE0UT(PTR, BYTES, BLANKStLINE)}  (♦  WRITES  OUT  THE  LINE  AT  PTR  *) 

line:=line+i 
until  (line>screenheight)  or  {ptr>=bufcount) 

end; 
end; 

PROCEDURE  READJUST(*cURSOR:PTRTYPE;  delta:  INTEGER*); 


(♦ 


THEN  MOVE 
CURSOR  BY 


ALL  AFFECTED 
DELTA  ♦) 


MARKERS  TO  CURSOR.   ALSO  ADJUST  ALL 


IF  DELTACO 
MARKERS  >= 
VAR 

i:  INTEGER; 
BEGIN 

WITH  PAGEZERO  DO 

FOR  i:=0  TO  COUNT-1  DO 

IF  pOFFSETCi:>=CURSOR  ThEN  POFFSETCI 3;=MAX( POFFSETC I 3+DELTA, CURSOR) ; 

IF  (copystart>=cursor)  and  (Copystart<8UFcounT)  then 

COPYstART:=MAX(COPYSTART+DELTA, CURSOR) ; 


3101 

3o:o 

aj 

3105 

3o:o 

94 

3106 

3i:o 

1 

3107 

3i:d 

4 

310a 

3i:d 

4 

3109 

3i:u 

4 

3110 

3i:d 

4 

3111 

3i:o 

4 

3112 

3i:d 

4 

3113 

3i:d 

4 

311*+ 

3i:d 

4 

3115 

3i:d 

4 

3116 

31. 'D 

7 

3117 

3i:d 

9 

3118 

3i:o 

0 

3119 

3i:i 

0 

3120 

31:2 

0 

3121 

31:3 

0 

3122 

31:3 

3 

3123 

31:3 

6 

312«f 

31:3 

8 

3125 

31:3 

26 

3126 

3i;4 

29 

3127 

31:5 

29 

3128 

3i:6 

29 

3129 

3i:6 

34 

3130 

31:5 

34 

3131 

31:5 

54 

3132 

3116 

68 

3133 

31:5 

69 

3^3^ 

3i:6 

75 

3135 

31. -5 

78 

3136 

31:4 

83 

3137 

31:3 

83 

3138 

31. '4 

85 

3139 

3115 

85 

31fO 

31:5 

88 

3141 

3i:4 

02 

31f2 

31:3 

07 

3143 

31:3 

16 

3144 

31:3 

27 

end; 

PROCEDURE  THEFIXER(*PAKAPTR:PTRTYPE;RFAC: INTEGER ;WH0LE-BQOLFAM*i. 

**  rSr^p'^^^'"''  SOMEWHERE  IN  A  PARAGRAPH.   IF  ;hSle;s?rSe  THEN  THE 

ENTIRE  PARAGRAPH  IS  FILLED,  OTHERWISE  ONLY  THAT  DIRECTLY  AFTER  THrrnR<;nR 
IS  FILLED.   RFAC,  WHEN  IMPLEMENTED  WILL  TELL  HOW  MANY  pIrJgrAPhJ  TO  rp 
FILLED.   note:  A  PARAGRAPH  IS  DEFINED  AS  LINES  OF  TEXT  SnfS^T^n  Ir    ?  .  tm. 
RiN^Fp^^H'^r  °'  ''    WHATSOEVER,  OR  A  LINE  'ol    aS^^t'SI^Js^'^ Jp^^r^HA^^^TE^rL 

VAR 

saveiPtr»wptr:  integer? 
wlength,x:  integer; 
done:  boolean; 
begin 

WITH  PaGEZERO  do 

begin 
save:=cursor; 
cursor:=paraptr; 
getleading; 

IF  EBUF-CSTUFFSTART3  IN  CCHR(EOL) .RUN0FFCH3  THEN  EXIT{THEFIXER ) • 

BEG?n'  '"''  '*    ''''  BACKWARDS  FOR  THE  BEGlNKlNG^rilE  P^RAGRipH  *) 
REPEAT 

cursor:=linestart-i; 
getleading 

UNTIL    (LINESTART<=1)    OR    (EBUF-^CSTUFFSTaRTD    IN    CRUNOFFCW.rwR  (rni  n»  . 

'^?'i'!;'''"^'''^^«'^    ^^    CRUNOFFCH.CHRCEOUJ    THEN  "      "'■'''^' 

PTR.— CURSOR+1 

ELSE 

ptr:=i; 

X:=PARAMARGIN; 
END 
ELSE 
BEGIN 

ptr:=linestartj 

if  blanks=paramargin  then  x:=paramargin  else  xi=lmargin 

END , 

cursor:=bufsize-(bufcount-ptr)+i;  («  split  the  buffer  «) 
moveright(ebuf-cptr3,ebuf-ccursord,bufcount-ptrTi 

(*  NOW  dribble  back  the  (REST  OF  THE)  PARAGRAPH  *) 
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'^1 


ilfS 

31 

'.6 

27 

3116 

31 

'.5 

32 

Sl^+T 

31 

:z 

41 

5148 

31 

15 

46 

si'+g 

31 

:3 

53 

3150 

31 

53 

bo 

3151 

31 

:4 

56 

3152 

31 

:5 

71 

3153 

31 

:4 

93 

3154 

31 

54 

96 

3155 

31 

:4 

96 

3156 

31 

:4 

23 

3157 

31 

:4 

23 

3158 

31 

14 

46 

3159 

31 

:5 

56 

3160 

31 

:4 

78 

3161 

31 

14 

85 

3162 

31 

!5 

06 

3163 

31 

16 

06 

3164 

31 

!6 

21 

3165 

31 

!6 

33 

3166 

31, 

16 

44 

3167 

31! 

16 

49 

3168 

311 

15 

49 

3169 

311 

14 

54 

3170 

3i; 

!4 

59 

3171 

311 

!4 

66 

3172 

311 

.5 

78 

3173 

3i; 

>6 

78 

3174 

31! 

.6 

86 

3175 

31! 

7 

91 

3176 

31! 

8 

91 

3177 

31! 

8 

93 

3178 

31! 

8 

99 

3179 

31! 

8 

10 

3180 

31! 

8 

10 

3181 

31! 

8 

10 

3182 

31! 

9 

14 

3183 

31! 

0 

14 

3184 

31! 

0 

23 

3185 

3i: 

0 

23 

(*  SENTINEL  FOR  GETLEADING  ») 


DO 
ELSE 


EBUF*CPTR3:=CHR(DLE) ; 
E3jF"CPTR+ia:=CHRtX+32) ; 

ptr:=ptk+2; 

ebuf'*c:cursor-i::=chr(eol) 

OOMr:=FALSE; 
REPEAT 

WHILE  EBUF'^CCURSORH  IN  CCHR  (  HT  )  .  CHR(  SP)  »CHR  (  OLE  )  3 
IF  EBUF'*CCURSORD  =  CHR(DLE)  THEN  CURS0R:=CURS0R  +  2 
WPTR:=CURSOR; 
{♦  SKIP  OVER  A  TOKEN  *) 

WHILE  NOT  (EBUF'^CCURSORJ  IN  CCHR(EOL)»'  •»»-»D) 
(*  SPECIAL  CASES  FOR  ".<SP><SP>"  AND  "-<SP>"  ♦) 
IF  E3UF'^CCURS0R3=«-'  THEN  IF  EBUF'^CCURSOR  +  1 3=* 
IF  (EBUF'"[:CURS0R-13=«,«)  THEN  IF 

(EBUF'*CCURSORD=»  •)  AND  (EBUF'»CCURS0R  +  1  D=» 
WLENGTH:=CURs0R-WPTR+1;  (*  including  THE  DELIMITER  *) 
IF  (X+WLENGTH>RMARGIN)  or  (RMARGIN-LMARGIN+1<=WLENGTH) 
BEGIN 

if  ebuf*cptr-13='  '  then  ptr:=ptr-l; 
ebuf'*cptr3:=chR(eol)  ;  ebuf'*cptr+13:=chr(dlE)  ; 

EBUF'"CPTR+23:=CHR(LMARGIN+32)  ; 

ptr:=ptr+3; 
x:=lmargin 
END; 
cursor:=cursor+i; 

w|0VELEFT(EBUF^CWPTR3.EBUF'^CPTR3»WLEN6TH); 

IF  ebuf'^i:cursor-13=chr(eol)  then 
begin 
if  ebuf'*ccursoR3=chr(0)  then  done:=true 

ELSE 

begin 
getleading; 
done:  =  (ebuf^i:stuffstartd=chr(eol)) 

or  (EBUF'*CSTUFFSTART3=RUN0FFCH)  ; 

(*  the  last  transfer  will  move 

over  the  <eol>  for  the  paragraph  *) 

IF  NOT  done  then 

begin 
ebuf*cptr+wlength-ij:='  »; 

(*  IF  <E0L>  <SP>»  MAP  to  ONE  SPACE  ONLY  *) 
if  EBUF'*CCURS0R-23='  •  THEN  PTR:=pTR-l; 


cursor:=cursor+ 


DO  CURS0R:=CURS0R+1; 

•  THEN  cursor:=cursor+i 
•)  THEN  cursor:=cursor+i 


THEN 


318o  1  31  :y  .33  Ffjii 

.^1H7  1  ,ii:7  ja  E,^j       "^ 

3136  1  31:5  38  ZUD ; 

■ilS3  1  3i:4  38  X:=X  +  WLENGTH; 

<Ta?  !  ^^•'^  "^^  ptk;=ptr+wl?:ngth; 

^l^i  1  3i:3  ^8  UNTIL    DONl; 

3192  1  3i:3  51 

3193  1  31, '3  63 

3^15  I  tl'-l  Ih  M0VELEFT(EBUF'^CCURS0R3,EBUF-CPTRD,BUFSIZE-CURS0Rn); 

■Jj-^a  i  01.3  3d  FRiic^r  AiirrniiMT  t  •  =ruo  /  n  «  .  w       a. »  , 

3196  1  3i:3  90 


READJUSKPARAPTR. (BUFSIZE-CURS0R+PTR+1)-BUFC0UnT) ; 
BUFCOUi\IT:=BUFSlZt-CURSOR  +  PTR  +  l; 


3197       1       3i:3         00  getleading; 


E3UF"C8UFCOUi\ITa:=CHK(0) 
CURSOR  :=MIW(BUFCOUrgT-l»  SAVE)  ; 


3198  1  31:3  LJ2 

3199  1  31:2  04        end; 

3200  1  5i:o  10  end; 

3201  1  31;q  3Q 


CURSOR :=MAX( CURSOR, STUFFSTART) 


ttll       J  IV.?  ^   PROCEDURE  getname(*msg:string;  var  miname*) 

3203    1    32;U     '+'+  VAR 


VAR 

3204  1  32:u  44  i:  INTEGER; 

3205  1  32:d  45  S:  STRING; 
320o  1  32:0  0  BEGIN 

3208  I  ^\l  ,?  REaSJs)!''"'"^'''  ^°""  CLEARLINE(O);  WRITE(MSG,'  WHAT  MARKER?  M 

^??n  ^  IV.^  tl  ^^^   ^-=1  ^°  length(S)  do  sc I ]:  =uclc ( sc I d)  ; 

llYt  \  \l\\  00  WOVELEFT(SC1D,ML03,MIN(8.LENGTH(S))); 

3?1P  7  ll'.l  It  ^Il-LCHAR(MCLENGTH(S)J.MAX(0,8-LENGTH(S)),»  •) 

ot:i.ei  1  od.'O  35  END; 

3213  1  32:0  50 

3214  1  32:0  50 

3215  1  32:0  50  (*$I  UTIL  *) 

3216  1  32:c  50 

ll\l  \  J-0  0  BEGIN  (♦  SEGMENT  PROCEDURE  EDITOR  *) 

5219  1  lii  26  REPeJ?*"^^^'  GETLEADING;  CURS0R:=MAX  ( CURSOR ,  STUFFSTART)  ; 

322?  \  V'-l  1%  CENTerCURSOR(TRASH»(SCREENHEIGHT  DIV  2)+1,TRUE); 

^ttl  \  needprompt:=true; 

\tA  ;  V'.'i  !^  ^^    USERINFO.ERR3LK>0  THEN  PUTSYNTAX; 

tii  ^  ^'^  ^^  REPEAT 

Iz^'l  ]  J--3  =1  home;  CLEARLINE(O); 

f225  1  1:3  56  EDITCORE; 

^  ^-^  ^^  IF  command=setc  then  environment 
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«>  -  , 


i227 
3228 
3229 
'5250 
3231 
5232 
3233 


6'+  ELSL:    if    CO"''!,^AhiD  =  t^OPYC    ThlEM    COPYFILEI 

7'+  UIJTiL    C0^1f'1Ai^C  =  QUlTC; 

ij2  UNTIL    OUT; 

•^9  SYSCOW^.MISCirjFO.NoBHEAK     :=    FALSE       (*    28    SEPT    77*) 

96  end; 

22 

0  BEGIN    END, 


4 
5 

7 

3 
9 
10 
11 
12 
13 
If 
15 

-1  I' 

i.o 
17 
18 
19 
20 
21 
22 
23 
24 
25 

26 

27 

2d 

29 

30 

31 

32 

33 

34 

35 

36 

37 

36 

39 

40 

41 

42 


X 

1 

-L 
1 

1 
1 
1 
1 
1 
1 
1 
1 
1 
i 

1 

1 

X 

0 
0 
0 

c 

0 
0 
0 
u 

c 
J 

0 
0 

J 

0 
0 
0 

J 

0 
0 
0 
0 
0 


i 
1 

1 

1 

l; 

i; 

i; 

i; 

i: 

1 

1 


•  1^ 
:g 
i:d 
i:j 

l.-D 

i:d 

i:d 

i:d 

i:o 

i:j 

1:3 

i:rj 

i:o 

1:0 

i:d 

1:3 

1 

1 

1 

1 

1 

1 

1 

1 

1 


D 
D 


:u 
:d 
:d 
:d 


1:0 
i:d 
i:j 
i:d 
i:d 
i;3 


1 
1 

I 
1 
1 
1 

X 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


SCr<rEN  ORIENTED  E.DITOR 


3r  RICHARD  S.  KAUFMANNt 
IIS 

UNWERSITY  OF  CALIFORNIA,  SAN  OIEGO 
LA  JOLLA  CA  92093 


JULY  8,  1978 


/  \ 

\  VERSION  \ 
\  L.2  \ 
\ / 


C0PYRI3HT  (C)  1978,  BY  THE  REGENTS  OF  THE  UNIVERSITY  OF 
CALIFORNIA  AT  SA[<j  DIEGO 


{*SL  PRi.gTER:  *) 
(  *  i  S  +  *  ) 

*) 
*) 
*) 
♦  ) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 

*) 

**************************  *******^*^*^*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  J 

( *JU-*) 

PR0GRA»^  PASCaLSYSTEM; 

CONST 

VI0LEN5  =  7;   (*  NUMBER  OF  CHARACTERS  IN  A  VOLUME  ID  *) 
TIOLEN3  =  15;  (*  NUMBER  OF  CHARACTERS  IN  A  TITLE  ID  *) 

TYPE 

VID  =  STRINGCVIDLENGJ; 

TID  =  3THIngctidleng:i; 

OATEREcrPACKED  RECORO 

month:  0,.12; 
day:    0,.31; 

year:  0..100 

end; 

inforec  =  record 

trashi,thash2:  integer; 

ERRSYM,ERRBLK,ERRNUiV!:  INTEGER;     (*  ERROR  COM  FOR  EDIT  *) 
TRASH3:  ARRAY  CQ..2D  OF  INTEGER; 
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201 


'+^^  J  i:c  1  CjOTsr Ji,GUTcoD£.:  booleam; 

'+^  0  i:j  1  wo  <kvid,sy^^vidicodevid:  vid;     (*  perm^cur  workfile  volumes  *) 

'^^  ■;  !:-■  1  WD^KTlcSYf^TlL.COJLlTIu:     TIj                     (♦    PERMiCUR    WORKFILE    TITLES    *) 

^o  0  1:D  1  ■     ZUD    (*IfJFOKEC*)     i 

•+7  :  i:^  1 

"+6  0  1:D  1  SYSCOi-^'^rC    =    RECORD 

^+9  d  i:o  1  junk:  array  co..6D  of  integer; 

50  0  i:c3  1  last:«ip:  I'-jteger; 

51  3  1:3  i  EXPAh^SlON:    ARRAY    CO, .20]    OF    INTEGER; 

52  0  1:0  1  viiscKif-O:     PACKED    RECORD 

53  3  1:0  1  nobreak, stupid, slowterm* 

5'+  0  i:d  1  hasxycrt.haslccrt,has85ioa,hasclock:  boolean 

55  0  1:D  1  END; 

56  u  i:d  1  crttype:  integer; 

57  0  1:0  1  crtctrl:  packed  record 

58  0  i:d  1  rlf,ndfs,eraseeol,eraseeos,home«escape:  char; 

59  0  i:d  1  backspace:  char; 

60  0  1:D  1  FILLCOUNT:  0.,255; 

°i  0  i:d  1  expansion:  packed  array  C0..33  of  char 

62  0  1:0  1  end: 

63  0  i:d  1  crtinfo:  packed  record 

6*+  0  i:d  1  WIDTH, height:  integer; 

65  0  1:d  1  right, LEFT, DOWN, up:  CHAR; 

66  3  1:D  1  BADCH,CHARDEL, STOP, BREAK, flush, EOF:  CHAR; 

67  0  i:d  1  altmode,linedel:  CHAR; 

68  a  i:q  1  expansion:  packed  array  co..5:i  of  char 

69  0  i:d  1  end 

70  0  1:0  1  END  (♦SYSCOM*); 

71  J  i:d  1 

72  3  1:0  1  vAR  (*  1.4  GLOBALS  AS  OF  oO-JAN-78  ♦) 

73  0  I:D  1  SYSCOM:  ''SYSCO^''iREC; 

74  a  1:d  2  TRASHY:  ARRAY  CO. .53  OF  INTEGER; 

75  3  i:d  a  userinfq:  INFOREC; 

76  0  1:D  54  TRASHYy:  ARRAY  C 0 . . 4  J  OF  INTEGER; 

7  7  0  i:'j  59  sy\/id,.:kvio:  VID; 

76  u  i:j  o7  thedaTe:  oaterec; 

7ii  0  1:D  l.3 

80  0  1:D  63 

81  0  1:L)  ^^3  (*4TEDIT3F<    SEGMEiJT*) 

82  1  i:n  1  SEGMENT    PROCEDURE    EDITOR; 

33  1  i:d  1  const 
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1 
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1 
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a. 
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i:  J 
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91 

1 
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i:l 
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97 
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i:d 
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93 

1 

i:3 
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99 

1 

i:d 
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100 

1 

i:u 

1 

101 

1 

i:d 

1 

102 

1 

i:d 

1 

103 

1 

i:d 

1 

10'+ 

i 

i:c 

1 

105 

1 

i:d 

1 

106 

1 

i:d 

1 

107 

1 

i:d 

1 

108 

1 

i:l) 

1 

109 

1 

i:d 

1 

lie 

1 

i:d 

1 

111 

1 

i::' 

1 

J. 

112 

1 

i:d 

113 
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i:d 

1 

im- 

1 

i:c 

1 

115 

1 

i:b 

X 

116 

1 

i:d 

1 

117 

1 

i:d 

1 

118 

1 

i:o 

1 

119 

1 

i:q 

1 

120 

1 

i:d 

1 

121 

1 

i:d 

1 

122 

1 

i;o 

1 

125 

1 

i:l 

1 

12!+ 

1 

i;c 

1 

(*    L.rjL:sS    OTHLR.'jISf    iJOTrO    ALL    COf^STANTS    ARE    UPPER    BOUh^DS 
FRD'.]    ZLkO.  '^j 

^^AXBUFSIZE  =  32767; 

'^AXSw  =  Jt+;     (*    MAXI?.1UM    ALLOWABLE    SCREENWIDTH    *) 

MAXSTRiljG  =  127; 

'riD"r'c.::?f' ..'rBj^'srsM"":,"""''"  ''   characters  on  a  line  i.  the  ebuf  ., 

CHA^irj3UF  =  204a;   (*  FOR  Fi;^AL  VERSION.  WOT  USED.  *) 
■■•1AX0FFSET  =  iC23;  (*  MAXIMUM  OFFSET  IM  A  PAGE  *) 
.•'1AXPAGC  =  255;  (*  RIDICULOUS  UP^ER  BOUND!  *) 

(*  THE  FOLLOWING  ASCII  CHARACTERS  ARE  HARD-WIRED  IN  *) 
BSPCE=3;  HT=9;  LF=10;  E0L=13;  JLE=16;  SP=32; 
DC1=17;  3ELL=7;  RUbOUT=i27;  CR=13; 

TYPE 

PTRTYPE  =  0..i^AX3UFSlZE; 

BUFRTYPE=PACKED  ARRAY  CO.,0]  OF  CHAR; 
3L0CKTrPE=PACKED  ARRAY  C0..511D  OF  CHAR; 
ERRORTypE={FATAL,NONFATAL) ; 
TABATTRiBUTE=(NONE,LEFTjUST,RIGHTJUST,DECIMALSTOP): 

offset=:o..maxoffset; 
page=o..maxpage; 

NAiV!E  =  PACKED  ARRAY  C0..7]  OF  CHAR; 

PTYPE  =  PACKED  ARRAY  C  0  .  .  ^^AXSTRING  D  OF  CHAR; 

COM^^ANDS=(  ILLEGAL,  ADJUSTC,  BAfJISHC  COPYC,  DELETEC,  FINDC,  INSERTC,  JUMPC. 

XEr^T^.'^^APr''^;  To''''    ''^''^    '^'''^    REPLACE?'  SEKriERlFYc'' 
XECUTEC,  ZAPC,  REvERSEC,  FORWARDC,  Up,  DOWN,  LEFT,  RIGHT.  TAB, 

rrvoc-    c  ^^"^'  ^^'"^^'  ADVANCE,  SPACE,  EQUALC,  SLASHC); 
CTYPE=(FS,GOHO>v|E,ET0L0L,ET0E0S,US); 
LEFTRISHT=(LEFTSTACK.RIGHTSTACK) ; 

HEADERz     (*  PAGE  ZERO  LAYOUT  CHANGED  20-JUN-78  ♦) 
RECORD  CASE  BOOLEAN  OF 

true:  (BUF:  PAcKLD  ARRAYC0..fJ!AXOFFSET]  OF  CHAR); 
false: (DEFINED:     INTEGER;  (*  NEW  FILE  =>  0;  OLD  FILE  =>  1  *) 
^^S!;irI*       INTEGER;   (*  THE  COUNT  OF  VALID  MARKERS  *) 
name:        ARRAY  :0..193  OF  PACKED  ARRAY  CO. .73  OF  CHAR; 
PAGEN:       PACKED  ARRAY  CO. .193  OF  INTEGER;  205 


206 


l^b 

1 

x:d 

I 

126 

i_ 

i:d 

1 

127 

•J 
i. 

i:j 

1 

123 

i:d 

i 

129 

i:l 

1 

130 

i:d 

i 

151 

i:d 

1 

152 

i:d 

1 

1'66 

I'.D 

i. 
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i:c 
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147 

i:d 
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i:d 
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i:d 

3 

150 

i:d 
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iDl 
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10 

152 

i:d 
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i:d 
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i:d 
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i:d 
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i:c 
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i:d 

272 
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i:l 

273 

IfaC 

i:d 

274 
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1:0 

275 

lo2 

i:d 

279 
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i:d 

2(30 

164 

i:u 

2  32 

165 

1 

1:0 

2bi 

poffset: 

packej  array  lo 

TAdSTOP: 

PACKED  ARRAY  CO 

AUTOiJNJOElNT: 

dOOLEAfJ;  (*  ENV 

filling: 

booleam; 

TOKQEF: 

LjOOLEA^nI; 

lmargi'ni: 

o..MAXSw; 

rmakgin: 

G.,^«AXSw; 

pak'\^argin: 

O..MAXSw; 

ruiJOFFch: 

CHAR; 

CREATED: 

DATEREC; 

lastupd: 

DATEREC; 

revision: 

INTEGER; 

filler: 

ARRAY  CO. .913  0 

19:  OF  OFFSET; 

1273  OF  tabattribute; 

ENVIRONMENT  STUFF  FOLLOWS  *) 


INTEGER) 


end; 


VAR 


CURSOR;     0..MAX3UFSIZE; 
BUFCOUgi:     O..MAXt3UFSlZE; 

stuffstart:  o..maxbufsize; 
linestart:  o..max3ufsize; 
bytestblanks:  integer; 
ch:  char; 
direction:  char; 
REpeaTfactor:  integer; 
BUFSIZ-::  mEGER; 
screenwioth:  integer? 

3CREENHEIGHT:  INTEGER; 

command:  commands; 

LASTPAt:  0.,MAX3UFSIZE; 

ebuf:  -^bufrtype; 

kind:  array  CCHAR3  CF  INTEGER; 
LINEIPTR:  O..MAXBUFSIZE; 

MIDDLE:  integer; 
NEEDPRof-iPT:  boolean; 

ETX,3S,CELiESC:     INTEGER; 
FLENGTr-i:     IiJTEGER; 

lpage»rpage:  integers 
trash:  integer; 
TARGET:  ptype; 


(*  NUMBER  OF  VALID  CHARACTERS  IN  THE  EBUF  *) 

(*  GETLEADING  *) 

(*  SETS        *) 

(*  THESE  *) 


(* 


OR  •<•  *) 


(*  MOVED  TO  VAR  26-JAN  ♦) 
(♦    "     II   II     II     *) 


(*  FOR  TOKEN  FIND  *) 

(*  MIDDLE  LINE  ON  THE  SCREEN  *) 

{*  MOVED  FROM  CONST  30-JAN-78  *) 

{*  THE  LENGTH  OF  THE  WORKFILE  IN  PAGES  *) 

(♦  LEFT  AND  RIGHT  STACK  POINTERS  *) 

(*  TOTALLY  WITHOUT  REDEEMING  SOCIAL  VALUE  *) 


i  bo 
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189 
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191 

192 

193 

194 
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197 

193 

199 
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201 
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203 

234 

205 
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1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
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1 
1 
1 
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9 
9 
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1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


i:„ 
i  I  _. 
i:[. 
i:u; 
i:d 
i:d 
i:o 
i:l 
i:C' 
i:d 
i:ij 
i:d 
i:l 
i:d 
i:o 
i:d 
i:o 
1:5 
i:g 
1:0 
i:o 
i:g 


1 
l; 
1 
1 

1: 
2; 
3; 
4; 
5; 


0 

0 

0 

0 

0 
0 

D 
0 
0 

6:d 

T.'l) 

a:D 
9:d 


10 
11: 

12; 
13; 
14; 
15: 


J 
3 

D 
0 
Z) 
Q 


047 
411 
■+13 
415 
417 
419 
4  J!G 
460 
53  0 
7ob 
1263 
1309 
135  0 
1391 
1903 
1946 
2023 
0 
0 
0 
0 
12 
12 
12 
12 
12 
12 
1 
1 
3 
1 
1 
1 
3 
3 
1 
1 
3 
3 
i 
1 


SUbSTRp^G: 
SLl'jGTH,TL[ 


'3TYPL 

|~J  G  T I  i  I 


INTEGER 


(* 
(* 
(* 
(* 
(* 


SDEIFIiJED.TDEFINEC:  tSOOLEAfg; 

copyle  j&TH, COP Ys Tart:   ptrtype; 

COPYLlMEtCOPYOK:  3G0LEAN; 
INFIMITY:  BOOLEAN; 

thefile:  file; 

pr:  fUl; 

translate:  array  ccharj  of  co^imands 

pagezekd:  header; 

msg:  String; 

proi^ptline:  string; 

savetop:  string; 

pagebuffer:  packed  array  co 

blankarea:  packed  array  co. 

wfnaviEiBACkfname:  string; 


SEGwiENT  procedure  NJ1V12 

SEGMENT  procedure  NUM4 

SEGMENT  PROCEDURE  NU^/!6 

SEGMENT  PROCEDURE  NJW8 


LENGTH  OF  TARGET  AND  SUBSTRING  *) 
i/.HETHER  THE  STRINGS  ARE  VALID  *) 
FOR  CCiPYC  *) 


FOR 


slashc  *) 


(*  DEBUG  *) 


(*  DUMB  TERMINAL 
..1023:  OF  CHAR; 
.MAXSWJ  OF  CHAR; 


PATCH  -  FOR  BLANKCRT(l)  *) 


BEGIN 

END; 

SEGMENT 

PROCEDURE 

NUM3; 

BEGIN 

end; 

BEGIN 

END; 

SEGMENT 

PROCEDURE 

NUM5; 

BEGIN 

END; 

BEGIN 

end; 

SEGMENT 

PROCEDURE 

NUM7; 

BEGIN 

end; 

BEGIN 

EMD; 

SEGMENT 

PROCEDURE 

NUM9; 

BEGIN 

end; 

(*  FORWARD  DECLARED  PROCEDURES..  ALL  PROCEDURES  ARE  IN  MISC  AND  UTIL  *) 

PROCEDURE  ERROR(S:STRING;HOwSAD:ERR0RTYPE) ;  FORWARD; 

PROCEDURE  ERASET0E0L(X»LINE:INTEGER) ;  FORWARD; 

FUNCTION   GETCH:CHAR;  FORWARD; 

PROCEDURE  CLEARSCREEN;  FORWARD; 

PROCEDURE  ERASEOS{X,lINE:INTEGER) ;  FORWARD; 

PROCEDURE  CLEARLINE(y:INT£GER) ;  FORWARD; 

FUNCTION  maptocommand<ch:char) :  commands;  forward; 
FUNCTION  uclc(Ch:char) :  CHAR;  forward; 
procedure  prompt;  forward; 
procedure  redisplay;  forward; 

function   MlN(A»3:iiMTEGER)  :  INTEGER;  FORWARD; 

function     max(a»b:integer)  :    itjteger;   forwaRD; 

PROCEDURE  C0NTR0L(CH:CTYPE) ;  FORWARD; 

hhocedure  putmsg;  forward; 
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20ii 

2iiy 

210 

211 
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213 

21'+ 

215 

21b 

217 

218 

219 

220 
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222 
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229 

230 

231 

232 

233 

231 
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23o 

237 
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2^+0 
2^+1 
2'+2 
2^5 
2'+<+ 
245 
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2^+7 
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1 

1 
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1 
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1 
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1 

1 

1 

1 

1 

1 

1 

10 

10 

10 

10 

10 

10 

10 

10 

10 

IJ 

10 
13 
10 
IG 
10 
13 
lU 
10 


16 

L7 

16 

13 

20 

20 

21 

22 

23 

21 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

35 

35 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

2 

2 

2 

2 
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u 
.J 

tj 
J 
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■j 

D 
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0 

0 

0 

0 

D 

0 

D 

C 

0 

D 

D 

D 

D 

D 

D 

D 

D 

D 

D 

D 

D 

D 

D 

D 

Q 

D 

D 

D 

D 

0 

1 

1 
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1 
6 
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1 
i 
3 
1 
3 
1 
1 
1 
1 
1 
1 
1 
3 
3 
1 
2 
2 
1 
1 
1 
1 
1 
2 
3 
5 
6 
12 
53 
565 
533 
1 
0 
0 
3 
38 


pKOCEDiJRi 

pROC£DURE 

procedjr;: 
functioim 

procedure 

FORiAlARD; 
PROCEDURE 
PROCEDURE 
FUNCTION 

■■PROCEDURE 
FUNCTION 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

FUNCTION 

FUNCTION 

PROCEDURE 


ho'ie;  fo.^waRU; 

-irrwait;  porwaru; 

3lankcrt(y:  integer);  forward; 

leadblanks(Pir:pt,<typl;var  bytes:  integer):  integer;  forward; 

CE,vlTERCURSOH(\/AR  LINE:  INTEGER;  LINESUP:  INTEGER;  NEWSCREEN:B00LEAN  ) 

FINDXY{VAR  INDENTtLINE:  INTEGER);  FORWARD; 
SHJWCURSOR;  KORwARD; 
GETNUM:  INTEGER;  FORWARD; 

3etlea0in3;  forward; 

oktodel{cursor,anchoR:ptrtype) :boolean;  forward; 
line0ut(var  htr:ptrtype;  bytes , blanks t line :  integer);  forward; 
upscreen(firstlineiwholescreen:30olean;  line:  INTEGER);  forward; 
readjust(cursor:  ptrtype;  delta:  integer);  forward; 
thefixer(Paraptr:  ptrtype;rfac:  integer;whole:  boolean);  forward; 
getname(Msg:string;  var  miname);  forward; 
getpages(which:leftright) ;  forward; 
putpages(which:leftright) ;  forward; 
readit(which:leftright) :  boolean;  forward; 
writeit(which:l£Ftright) :  boolean;  forward; 
checkindent(var  cursor : ptrtype ) ;  forward; 


I  Z  E*) 

initialize; 


(*$ti  n  i  t  i  a  l 
segment  procedure 

LABEL  i; 

TYPE  phyle=file; 

VAR 

block:  '^qlocktype; 

onewo:  '^integer; 

DONE,0\/FLw:  boolean; 

ch:  char; 

i»auit,gap,blkstpage»notnuls:  integer; 

filena^ie:  string; 

buffer:  packed  array  c0,.1023d  of  char; 

fibarea:  array  i:o..i7o  of  integer; 

PROCEDURE  map(ch:char;  c:commanos); 

BEGIN 

translate[:ch3:=c; 

IF  CH  IN  C'A'..«Z'0  then  TR ANSLATEC CHR ( 32+ORD ( CH ) ) 3 ; =C ;  (*  LC  TOO  *) 

rND; 
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266 
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267 
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82 
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10 
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44 
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IC 

5:d 

44 

279 

10 

5:d 

44 
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10 

5:d 

44 
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10 

5:d 

44 

232 

10 

5:d 

45 
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10 

5:o 
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52 

pROCi_[jJH(E  CLlANTITLEC  VAK  T;STRIMG); 

(*  ATTACHLS  THE  DEFAULT  '.TEXT'  TO  THE  END  OF  THE  FILENAME  IF  WECESSaRY.  *) 

y  C-GIN 

FOR    i:=i    TO    LENGTH(T)    00    TC IJ : =UCLC ( TC I j ) ! 

IF     (POS( •.TEXT',T)=lENGTH{T)-4)     AND    ( LENGTH ( T ) >=5 )     THEN 

0elete(t,length(t)-4,5)  ; 
wfname:=concat(Ti '.text')  ; 

BACKFfMA^lE:=CONCAT(Tf  '  .BACK*  )  ! 

END; 

PROCEDURE  DEFAULTPZ; 
BEGIN 

WITH  PAGE2ERG  DO 

IF  DrFlNED<>2  THEN 
3E3IN 

fillchar(buf,1024,chr{0) ) ; 
tokdef:=true;  (*  default  mode  is  TCOKEN  *) 
filling:=false;  autoindent:=true;  runoffch:  =  »'>»  ; 
lmargin:=o;  faramargin:=5;  rmargin:=screenwidth; 

(*  initialize  TABSTOPS  -  20-JUN-78  *) 

FOR  i:=Q  TO  15  DO  tabstopci*8d:=leftjust; 
created:=thedate;  revision:=-i;  lastupd:=thedate; 
defined: =2; 

END; 

end; 

procedure  changename(VAr  f:phyle;  t:string); 

(*  change  the  title  of  f  to  t.  note:  (d  the  file  f  must  be  closed  with 

CLOSE(F.LOCK),  AND  (2)  THIS  CODE  RELIES  ON  A  "SPECIAL  FEATURE"  IN  THE 
I/O  SUBSYSTEM,  NAMELY  WHEN  THE  YEAR  IS  SET  TO  100  THE  TITLE  GETS  UPDATED 
WHEN  THE  FILE  IS  CLOSED  *) 
VAK 

colon:  INTEGER; 

o:  daterec; 

FI3PA:  packed  array  CO. .573  OF  CHAR; 

BEGIN 

(*  MAKE  sure  that  THE  FILENAME  DOESN'T  INCLUDE  THE  VOLUME  NAME  (OR  "*")  ♦) 

colon:=pos(':',t) ; 

IF  COLr)tM>0  THEN  DELETE  (  T  ,  1 »  COLON  )  ; 

IF  TC1D='*'  THEN  DELETE  (  T  ,  1 , 1 )  ;  209 


no 


P.69 

IJ 

b:i 

•+7 

290 

10 

b:i 

S'b 

2^1 

13 

5:i 

a4 

292 

IJ 

5:i 

H2 

293 

13 

5:i 

91 

29^ 

10 

5:o 

99 

295 

10 

5:o 

112 

296 

10 

6:  J 

297 

ID 

6:o 

0 

298 

ID 

6:o 

3 

299 

10 

6:i 

0 

3C0 

10 

6:i 

10 

301 

10 

6:o 

31 

302 

10 

6:o 

44- 

303 

10 

7:d 

304 

10 

7:d 

305 

10 

7:d 

306 

10 

7:d 

307 

10 

7:d 

303 

10 

7:d 

6 

309 

10 

7:d 

7 

310 

10 

7:o 

0 

311 

10 

7:i 

0 

312 

10 

7:i 

22 

313 

10 

7:i 

60 

3m 

10 

7:i 

68 

315 

10 

7:i 

111 

316 

10 

7:i 

148 

317 

10 

7:i 

158 

313 

10 

7:i 

161 

519 

10 

7:i 

170 

320 

10 

7:i 

170 

321 

10 

7:2 

189 

322 

10 

7:2 

213 

323 

13 

7:i 

213 

32'+ 

10 

7:2 

213 

325 

10 

7:3 

252 

32b 

10 

7:i 

266 

327 

lu 

7:2 

234 

523 

IC 

7:i 

3G3 

329 

10 

7:i 

315 

:>^OVELE^-T{F,FlQr^A.DB)  ;  (♦  TRArJSFERS  THE  FIB  FOR  THE  FILE  F  TO  FIBPA  *) 
M0VELlFT(T,FIEPAC363»16) ; 

WITH  D  00  ,:>EGIN  0Ay:=2;  month:  =3;  year:=ioo  end? 

M0VELErT(D,FIBPACD63.2) ; 
^^0VELEFT{FI3PA^F»^ti) 

end; 

FUNCTION  FiNOLENGTHtVAR  F : PHYLE ): INTEGER ; 
BEGIN 

(*  KLUDGE  LOGIC.   RETURNS  THE  LENGTH  OF  THE  FILE  IN  PAGES!  *) 

M0VELE:FT(F,FIBAREAi36)  ; 

FINDLEN6TH:  =  (FIBAREAi:i7:-FlBAREAC163)  DIM    2; 

end; 

procedure  backup; 

(*  COPIES  THE  FILE  TC  BE  EDITED  TO  ANOTHER  FILE*  NAMES  THE  ORIGINAL  .BACK.  AND 

NAMES  THE  COPY  .TEXT  *) 
VAR 

inbnum,outbnum.outfslze.blksread.maxblockinbuf:  integer; 
ch:  char; 
f:  file; 

BEGIN 

REWRITE(F,BACKFNAME) ' 

if  IORESULTOC  THEN  ERROR ( 'CAN* » T  OPEN  BACKUP  FILE!   '.FATAL); 

outfsize:=findlength(F) ; 

if  outfslze<flength  then  error(»not  enough  room  for  backup!  '.fatal); 

WRlTEL:j( 'COPYING  TC  '  .  BACKPNAi^^E  )  ; 

rpage:=outfsize-flength+i;  (*  push  text  to  the  right  *) 

inbnum:=2:  (♦  first  valid  page  in  the  input  file  *) 

OUTBnUiVi:=RPAGE  +  RPAGE;  (*  first  block  to  copy  stuff  to  -  right  JUSTIFIED  *) 

(*  copy  over  the  page  zero  ♦) 

IF  BLOckREAD(THEFILE.PAGEZERO. 2,0)02  THEN 

ERR0^( 'READING  PAGE  ZERO '. FATAL ) ; 
(*  COMPENSATE  FOR  SHIFT  IN  FILE  ♦) 

WITH  PagEZERO  do 

FOR  i:=0  TO  COUNT-1  00 

PAoENCia:=PAGEhCl3+RPAGE-l; 

if  blockw/rite(f,pagezero.2.0)<>2  then 

errof<( 'writing  page  zero'. fatal); 
maxblockinbuf:=2Ufsize  qiv  512; 

REPEAT 


o3u 

331 

332 

333 

334 

335 

33s 

337 

338 

33y 

340 

341 

342 

343 

344 

345 

346 

3^7 

349 

350 

351 

352 

353 

354 

355 

356 

357 

358 

359 

360 

361 

362 

363 

364 

365 

366 

367 

368 

369 

370 


IJ 

10 

10 

IfJ 

10 

IG 

10 

10 

10 

lU 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 


7:2 
7:2 
7:2 
7:3 
7:4 
7:5 
7:4 
7:3 
7:2 
7:2 
7:i 
;i 
1 
1 
1 
1 
1 

0 
0 

D 
0 

1 
1 


7 

7 
7 
7 
7 
7 
7 

7: 

8: 

8; 

8; 

a: 

8:i 

8:i 

8:i 

6:i 

8:i 

s:o 


6; 
8; 
8; 
8: 


9:d 


9: 
9; 
9; 
9: 
9: 
i: 
i: 


:D 
0 
1 
0 
0 
0 

1 


3l3 

33  0 
363 


3  79 
HO  2 
43u 
'+30 
435 
436 
445 
453 
f&O 
'+67 
'+73 
'+77 
'+88 
510 
1 
0 
0 
3 
25 
'+2 
^S 
39 
97 
98 
114 
114 
114 
114 

3 

3 

0 
0 
8 

22 
0 
0 


If^i^l    l\^    C.HOHCBAO    I.PUT    PILE  .  •  ,  PATAL  ,  ; 

IF    lORESULTOO    THEN    ERROR  corj    BACKUP    FILE.' 

0UT3rjUM:=0UTd(\IUM  +  BLKSREAD; 
lN8Nu.V|:=INBf\IUM  +  3LKSREAD 
UMTIL    3LKSREAD=0; 

CHAfJGE,MAME(THEFILE,BACKFNAME); 
CLOSE(THEFlLEfLOCK) 


•FATAL) 


CHANGEf>|AME(F,WFNAME)  ? 
CLOSE(F,LOCK); 

fleimgth:=outfsize; 

RESET  (THEFlLEtWFIMAME) 

end; 


(* 
(* 


COPY  OVER  THE  LENGTH  ATTRIBUTE,       *) 
AND  *^AKE  THE  FILE  YOU  COPIED  THE  WORKFILE! 


♦  ) 


{*  DUMB  TERMINAL  PATCH  *) 


PROCEDURE  READFILEJ 
BEGIN 

clearscreen; 
writeln(«>edit:'); 

WRITE{»rEADING') ; 
RESET(THEFILE); 

J^j3L.0CKREAD{THEFlLE,PAGEZER0,2)<>2 
GETPAGESCRIGHTSTACK) 

end; 


(*  iA/AS 


POTENTIALLY 
THEN 


CLOSED  BY  BACKUP  ♦) 

ERROR( 'READING  FILE', FATAL) 


(*  PEOPLE  WITH  WORD  MACHINES  -- 

FUNCTION  BrTESLEFT:  INTEGER; 
(*  RETURNS  THE  NUMBER  OF  BYTES 
BEGIN 

8YTESLEFT:=(*  DOUBLE  FOR  WORD 

end; 


LOOK 


A  T 


ME   !  !  *) 


BETWEEN  BLOCK  AND  LASTMP  ♦) 
MACHINES  *)  {ORD(SYSCOM-.LASTMP)-ORD{BLOCK)) 


BEGIN 
WITfi 


pagezero  do 
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C-  1.  c 


371 

10 

2 

0 

372 

10 

2 

0 

373 

10 

2 

Q 

371+ 

Ij 

2 

u 

375 

10 

3 

Q 

37& 

lu 

3 

10 

377 

10 

3 

10 

378 

10 

3 

22 

379 

10 

5 

34 

380 

10 

3 

46 

381 

10 

3 

53 

332 

10 

3 

70 

383 

10 

3 

78 

38i+ 

IQ 

3 

78 

365 

10 

3 

90 

366 

10 

3 

102 

367 

10 

,3 

114 

38S 

10 

,3 

114 

389 

10 

,3 

114 

390 

10 

3 

114 

391 

10 

;3 

114 

392 

10 

;3 

114 

393 

10 

:4 

126 

394 

10 

:5 

126 

395 

10 

;5 

137 

396 

10 

:5 

148 

397 

10 

5 

159 

395 

10 

.4 

170 

399 

10 

;3 

170 

400 

10 

;3 

181 

401 

10 

:3 

185 

402 

10 

;3 

189 

403 

10 

:3 

193 

404 

10 

13 

193 

405 

10 

:3 

193 

406 

10 

:3 

193 

407 

13 

;3 

193 

406 

10 

:3 

218 

409 

10 

:3 

218 

410 

10 

3 

2ia 

411 

10 

3 

218 

oEGT 


{*     ll-ilT    THE    T.^AFjiiLATE    TABLE    *) 
FlLLCHAR(TRANSLATE.SlZEOF{TRANSLATE) .ILLEGAL) ; 


M A P (  'A 
W1AP(  'D 
MAP(  'J 
MAP(  'M 
MAP (  'R 
|V|AO(  'X 

!AI\p{  '  » 
V1AD(  '  + 
MAP(  V 


ADJUSTC) ? 
DELETEC) 5 
JUi>^PC)  ; 
NEXTC) ; 
REPLACEC)  ; 

XECUTEC) ; 

REVERSEC)  ; 
FORWARDC)  ; 
SLASHC) ; 


MAP( 
MAP{ 
MAP( 
MAP{ 
MAP( 
MAP( 

MAP( 
MAP( 
MAP( 


3» 


,BANISHC) 
,FINDC) 
L'  tLISTC) 
P«  fPARAC) 
S'.SETC) ; 

Z'.ZAPC) ; 


>• ,FORWARDC) ; 
-NREVERSEC)  ? 
=»,EQUALC) ; 


WAPCCCOPYC)  ; 
MAP( 'I* ilMSERTC) ; 
WAP{ •M»,MACRODEFC) ; 
MAp{»Q' tQUITC) ; 
MAP(  »\/NVERIFYC)  ; 


MAP( 


iFORWARDC) 


(*    ARROWS    *) 


(*  NEX 
IF    SYS 

3EGI 
MA 
MA 
MA 
MA 

|V1AP(SY 

MAp(CH 
MA3(CH 
MAp( CH 


tcom^^and  and  getnum  handle  vt-52 
com'".crtctrl,escape=chr(0)  then 

N 
P(SYSCOiM'^.CRTINFO,L£FT»LEFT)  ; 

P(SYSCOM'^.  CRT  INFO,  DOWN  I  DOWN)  ; 
P(SYSC0M^.CRTINF0, RIGHT* RIGHT) ! 
P(SYSCOW|''.CRTINFO,UP,UP)  ; 


MAP( '?• ,DUMPC) ; 
MAP( »<• .REVERSEC) ; 


STYLE  VECTOR  KEYS  ♦) 


SCOM'^.CRTINFO.CHARDEL.LEFT)  ; 
R(EOL) ^ADVANCE) ;  (*  CR  IS  ADVANCE  *) 
R(HT) iTAB) 5 
R(SP) .SPACE) ; 


(*  L'lGITS  *) 

FO^  CH:='0'  TO  •9»  DO  MAP ( CH . DIGIT ) ; 

(*  VARIABLE  BUFFER  SIZING...  ADDED  17-JAN-78  *) 


Hl^ 

J-  V 

1:3 

.?lo 

113 

i  "i 

i:  ,:^ 

-•?1 

'+1'4 

1  1 

1:3 

227 

415 

Ij 

i:3 

Zcl 

H16 

10 

1:3 

254 

417 

10 

1:4 

23  + 

418 

10 

1:4 

241 

419 

lU 

1:4 

246 

420 

10 

i:h 

25u 

421 

10 

1:3 

250 

422 

!■: 

1:3 

269 

423 

10 

1:3 

278 

424 

10 

1:3 

238 

425 

10 

1:3 

296 

42d 

10 

i;3 

296 

427 

10 

1:3 

296 

428 

10 

1:3 

296 

429 

10 

1:3 

296 

430 

10 

1:3 

3C0 

431 

10 

1:3 

3  04 

432 

10 

1:3 

307 

433 

10 

1:3 

310 

434 

10 

1:3 

313 

435 

10 

1:3 

335 

436 

10 

1:4 

340 

437 

10 

1:5 

34  0 

438 

10 

1:5 

362 

439 

10 

1:5 

366 

440 

10 

1:5 

397 

441 

10 

1:4 

421 

442 

10 

1:3 

424 

443 

10 

1:4 

426 

444 

10 

1:5 

426 

445 

10 

1:5 

486 

446 

10 

1:6 

466 

447 

10 

1:0 

436 

448 

10 

1:6 

511 

449 

10 

1:7 

519 

450 

10 

1:6 

519 

451 

13 

1:3 

542 

452 

10 

1:3 

546 

-wo,T.-H00u+        (*  SlZL0F(EDITC0RE)-SIZrOF(lrjlTlALIZ^)  *1 

•^12:  (*  SLOP!  *) 

•■^A^f*  (EBUD  ; 

3L-<s:=o; 
repiat 

MEW(6L0CK); 

3LKS:=BLKS+1; 

3AP:=9YTESLEfT-512       (*  3YTESLEFT  RETURNS  THE  tt    OF  BYTES  BETWEEN 
,  ,,   ,  THE  POINTERS  BLOCK  AND  LASTMP  *) 

UNTIL  ((GAP>0)  AND  (GAP<&UIT))  OR  (BLKS=63); 
BUFSlZt:=BLKS*5l2-l; 
IF  BUFSIZE<0  THEN  BUFSIZE  .*  =32767  ; 
NE,^(ONEWD);  ONEWU-:=0;   (*  SENTINEL  FOR  END  OF  BUFFER  -  FOR  M(UNCH  *) 

(*  OPEN  THE  WORKFILE  *) 

LPagE:=0;  (*  LEFT  STACK  EMPTY  *) 

BUF^OUNT---*  ^^^^^    ^^^^^  CONTAINS  ALL  OF  THE  WORKFILE  ♦) 

cursor:=i; 
clearscreen; 

ifliRlTELfg(«>EDIT:M  ; 
IF    USERINFO.GOTSYM    THEN 
oEGlN 

FILENAME :=cONCAT(USERINFO.SYMVlDi • : • . USERINFO.SYMTID ) ; 
CLEANTITLE(FILENAME);  '' 

RESET(THEFILI:.,WFNAME); 

IF    IORESUltOO    then    ERR0R(»W0RKFILE    LOST.', FATAL) 

END 

ELSE 

3EGIN 

^^S^=*NO  WORKFILE  Is  PRESENT.  FILE?  (  <RET>  FOR  NO  FILE  )  M 

WRITE(MSG) 5 
READLNdrjPUT, FILENAME)  ; 

^'"bEGIN^^"'^^^'^^"^'""  ^^^'^    '*  °^^^^    ^^    ^°°^    °'-'  SYSTEM. WRK. TEXT!  *) 

FILENAME  :  =  »*SYSTEM.iv'RK.  TEXT*  ; 
CLEANTITLE(FILENAME) ; 

FILLCHAR(E3UF-,3UFSIZE  +  1,CHR(0));  2l'i 


453 

IG 

i:a 

554 

454 

10 

1:8 

':j6 

'155 

10 

i:a 

JoB 

^+56 

10 

i:b 

bJ^ 

^+57 

I'J 

1:3 

587 

^+58 

10 

1:3 

625 

459 

10 

1:3 

625 

460 

10 

i:a 

625 

461 

10 

1:3 

S35 

462 

10 

1:3 

643 

463 

lU 

1:3 

663 

454 

10 

1:8 

705 

465 

10 

1:3 

712 

466 

10 

1:9 

712 

467 

10 

1:0 

712 

468 

10 

1:0 

747 

469 

10 

1:0 

781 

470 

10 

1:9 

738 

471 

10 

1:8 

793 

472 

10 

1:8 

820 

473 

10 

1:3 

326 

474 

10 

1:7 

328 

475 

10 

1:6 

828 

476 

10 

1:6 

832 

477 

10 

1:6 

343 

478 

10 

1:5 

370 

479 

10 

1:4 

876 

480 

10 

1:4 

876 

481 

10 

1:4 

376 

432 

10 

1:4 

376 

483 

10 

1:4 

876 

484 

10 

1:3 

376 

435 

10 

1:3 

386 

48b 

13 

1:3 

836 

487 

10 

1:3 

366 

488 

ID 

1:3 

836 

499 

10 

1:3 

8  36 

490 

10 

1:3 

833 

491 

10 

1:3 

e33 

4  92 

10 

1:5 

333 

493 

10 

1:3 

8  33 

ON  LINE*  tFATAL) ; 
THE  FILE 


LBUF'^COJ:=Cf-IR(EDL)  ; 

FILLCHAR(PAGEZER0.SIZE0F(PAGE2ER0) »CHK(0) ) ; 

aE/JRlTt.(THEFlLE,;jTiMME)  ; 

LiACKFNAiV|E:  =  ' •  ; 

IF    IORESUlTOO    TriErj    ERROR{ 'SYSTEM    VOLUME    NOT 

(*    ESTABLISH    THE    LENGTH    OF    THE    FILE    AND    LOCK 

TU  BE  THE  iMAXIMUf^l  EVEN  LENGTH  *) 
FLENGTH:=FINDLENGTH(THEFILE) ; 
IF  QDD(FLENGTH)  THEN  ^LENGTH: =FLENGTH-1 ; 
IF  3L0CKWRITE(THEFILE» BUFFER tl,2*FLENGTH-l) 01 

THEN  ERR0R(»FILE  SYSTEM  TERMINAL  ERROR • .FATAL ) ; 
CLOSE(THEFILE,LOCK) ; 
WITH  USERINFO  30 

BEGIN 

symvid:=syvid;  symtid:='system,wrk.text' ;  gotsym:=true; 
openold(thefile. • *system.wrk,code • ) ;  close ( thefile , purge ) 
gotcode:=false;  codetid:=«» 

end; 
reset {thefile,»*system.wrk. text*) 5 
rpage:=flength; 
goto  1; 
end; 

CLEANTITLE(FILENAME) ; 

openold(thefile:»wfname)  ; 
msg:='not  present,  file?  •; 
until  ioresult=o; 

END? 


(*  find  out  the  length  of  the  workfile  *) 

FLENG TH :=F I NDLENGTH( THEFILE) ; 

(*  IF  DESIREDt  COPY  THE  WORKFILE  (i^lAXIMlZlNG  EDITING  ROOM)  *) 
BACKUP; 


(*  READ  IN  THE  FILE  *) 


494 

IJ 

i:i 

■LIQ 

4-95 

10 

i:,5 

i9o 

49^ 

iO 

i:  5 

)i]3 

^97 

10 

i:i 

J 'J  a 

496 

10 

114 

31b 

499 

10 

1:5 

91b 

500 

10 

1:5 

■:?19 

501 

in 

1:4 

92  4 

502 

10 

1:4 

924 

503 

10 

1:4 

924 

504 

10 

1:4 

924 

505 

10 

1:4 

924 

50b 

10 

1:3 

924 

507 

10 

1:3 

927 

508 

10 

1:5 

930 

509 

10 

1:3 

934 

510 

10 

1:3 

938 

511 

10 

1:4 

946 

512 

10 

1:5 

946 

513 

10 

1:5 

957 

514 

10 

1:5 

963 

515 

10 

1:5 

979 

516 

10 

1:5 

990 

517 

10 

1:5 

998 

518 

10 

1:5 

1006 

519 

10 

1:4 

1014 

520 

10 

1:3 

1014 

521 

la 

1:3 

1023 

522 

10 

1:3 

1031 

523 

10 

1:3 

1031 

524 

10 

1:3 

1031 

525 

10 

1:3 

1031 

526 

10 

1:3 

1031 

527 

10 

1:3 

1033 

528 

10 

1:3 

1041 

529 

10 

1:3 

1041 

530 

10 

1:2 

1041 

531 

10 

1:2 

1041 

532 

10 

1:2 

1041 

533 

10 

1:2 

1041 

534 

10 

1:2 

1041 

f^lLLCHAR(E3UF-,tiUFSI2E  +  l,[;,|R(0)  )  ; 

E:3uF"i:0J;=CHR(roL)  ; 

1:     IF     (EBUF-C3JFC0UNT-1J<>CHR(ECL))     OR     { BUFCOUrJT=l )     THE^J 

'3  E  G I  i  J 

E3UF'^CBUFCCUNTD:=CHH(£0L)  ; 
3UFC0UhJT:=3UI-C0JNT  +  l; 

{*  INITIALIZE  EVERYTHING  ELSE!  *) 

DlfRECTlO[\i:  =  '>»  ; 

cSpYOKUpiLSEt    '"'"    '°    '''-    ^^^-'^^^""^    °f^    ™    ^^^^^^    ^FOR    "UALO    •) 

linjeiptr:=i; 

with  syscow^.crtinfo  do 

BEGIN 

ESC:=ORD(ALTMODE) ; 
ETX:=OKD{EOF) ; 
BS:=ORD(CHARDEL) ; 

del:=ord(linedel); 

screenwidth:=width-i; 

screenheight:=height-i; 

middle:  =  (scre:enheight  oiv  2)  +  1; 

end; 

syscow^.misciimfo.mobreak   :=  true; 

sdefined:=fal.se;  tdefined:=false;  <♦  no  substring  or  target  *) 

(*  SET  UP  PAGEZEKO  if  NEC,  ♦) 

dEfaultpz; 
re\/ision;=revision+i; 

ENQ(*    WITH  *) ; 
{*  INITIALIZE  THE  KIND  ARRAY  ^^OR  TOKEN  FIND  *) 
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^■^^  1^  I'l  l-'+l    FOR  CH:=CHH{0)  TO  CIIK(255)  DO    K IMOC  CH  j :  =ORD  ( CH )  ;   (+  hAKE  THEM  ALL  UNIQUE  ♦) 

53b  l:j  i:i  1071    FDR  cH:z'A«  TO  'Z'  DO  KINOC  CH  D :  =ORD  (  '  A  •  )  ? 

Ji7  Ij  i:i  10':,3  FOR  CH:r»A'  TO  'Z*  CO  KINDC  CHD :  =ORD  (  '  A  •  )  ? 

^33  IQ  l:i  1127    FOR  CH:='0'  TO  '3'     CO  K INQC CH D : =ORD ( • A • ) 5 

539  10  i:i  11-35   kindcchr(Eol)  ::=ORo( '  •);  kindcchrchT)  3  :=ord('  m; 

540  10  1:1  11^5         FILLCHAR(3LANKAREA,SIZE0F(BLftMKAR£A)  .'     •);     (*    FOR    UNITWRITING    BLATJKS    *) 

541  10  1:1  1177         SAVET0P:  =  »     •;        (*    FOR    BLAijKCRT(l)    -    SAVES    THE    PROMPT    OR    MSG    LINE    *) 

542  10  1:1  1153 

543  10  1:0  1133  £ND{*  INITIALIZE  *); 

544  IJ  1:0  1214 

545  iO  1:Q  1214 

546  10  1:0  1214  (*$T0  U  T*) 

547  11  i:d      3  SEGMENT  PUNCTION  OUT:  BOOLEAN; 
S'^S  11  1:D      3  LABEL  1,2; 

549  11  i:d      3  TYPE 

550  11  1;d      3    PHYLE=FILE; 

551  11  1:d      3  VAR 

552  11  i:d    3   save:  ptRType; 

553  11  1:D  4         RBNUM»L3NUM,l«!AXBLKSllMBUFiBLKSREAD,I:     INTEGER; 

554  11  i:d    9   auF:  packed  array  i:o..io23:  O!^  char; 

555  11  1:D  521    FN:  STRING; 

556  11  i:o  562 

557  11  2:D      1  PROCEDURE  CHANGENAME(  VAR  F.'PHYLE;  T:STRING); 

55Q  11  2:d   44  {*  change:  the  title  of  f  to  t.  note:  (d  the  file  f  must  be  closed  with 

559  11  2:D     44     CLOSt(F»LOCK) t  AND  (2)  THIS  CODE  RELIES  ON  A  "SPECIAL  FEATURE"  IN  THE 

560  11  2:d     44     I/O  SUBSYSTEM,  NAMELY  WHEN  THE  YEAR  IS  SET  TO  100  THE  TITLE  GETS  UPDATED 

561  11  2:o     44     WHEN  THE  FILE  IS  CLOSED  *) 

562  11  2:u     44  vAR 

563  11  2:d    44   colon:  integer; 

564  11  2:2     45    0:  DATerEC; 

5b5  11  2:d    1+6   fibpa:  packed  array  CO. .57:  0="  char; 

566  11  2:0      0  dEGIN 

567  11  2:0      0    (*  N^AKE  sure  THAT  THE  FILENAME  DOESN'T  INCLUDE  THE  VOLUME  NAME  (OR  "*")  *) 

563  11  2:1    0   colon:=pos( • : '.T) : 

569  11  2:1     13    IF  CCLDM>0  THETj  DELETE  (  T  ,  1 ,  COLON  )  ; 

570  11  2:1     52  IF  TC13='*'  THEN  DELETE ( T , 1 , 1 ) ; 

571  11  2:1     47    i^OVELEFT(F, FIBPA, 53)  ?  (*  TRANSFERS  THE  FIB  FOR  THE  FILE  F  TO  FIBPA  ♦) 

572  11  2:1     55    M0VELEFT(T,FIBPAC383.1b) ; 

573  11  2:1     64    WITH  D  DO  BEGI'J  DAY:=2;  MaNTH:=3;  YEAR:  =  100  ENc; 
374  11  2:1     32    M0VELEFT(D,FIBPA[:56:'2)  ; 

575  11  2:1     n    yOVELEFT<Fl3PA,F,52) 
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t,  Nj; 

PHUCEOijRE    SETLASTBLOCKdASTBLOCK:  INTEGER)  ; 

(*    KLUOGI    CODE    TO    REMO\/E    BLOCKS    FROM    THE    END    OF    THE    wORKFILE    ♦) 

VAR    FIBA-jeA:  ARRAY    CO.,  12  J    OF    irgTEGER; 

L^EGIN 

?'!0VELEFT(THEFlLE,FrBAREA.26)  ; 
FIdAREACl2  3:=LAST3L0CK; 
M0VELEFT(FI6AREA,THEFILE»26) ; 

end; 

BEGIN 

out:=false; 

REPEAT 

clearscreen;     {*  dumb  terminal  patch  *) 
savetop:='>quit: • ; 

WRITelN(SAVETOP) ; 

WRITeLN(«      U{PDATE  the  WORKFILE  AND  LEAVEM; 

WRITelN('      E(XIT  (BUT  WORKFILE  NOT  UPDATED)'); 

WRlTEtNC      R(ETURN  TO  THE  EDITOR  WITHOUT  DOING  ANYTHING'); 

CH:=UCLC(GETCH) ; 
UNTIL  CH  IN  C*U»t'E'''R'3; 
IF  CH='R'  THEN  GOTO  2; 
IF  CH=»E'  THEN 

BEGIM 

out:=true; 
clearscreen; 

CL0SE(THEFILE, PURGE)  ; 
IF  LENGTH(3ACKFNAME)>0  THEN 
3EGIN 

RESET(THEFILE,BACKFNAME) ; 
IF  IORESULT=0  THEN 
BEGIN 

CHANGENAME(THEFlLEiWFNAME) ; 
CLOSE(THLFILE,LOCK) ; 
END 
ELSE 

WRITELN( 'BACKUP  FILE  NOT  PRESENT  (TRIED  TO  REMOVE  IT).M; 
GOTO  2 

ELSE  GOTO  2;  ^'X/ 
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SLAf-.JKCrU  (1)  ! 

CURS0K:=3UFCOUNT+199;   (*  TAKES  CARE  OF  THE  SLOP!  *) 

^JRITE{  •  WRITING'  )  ; 

PUTPAGrs(LEFTSTACK) ; 

PAGEZEro.LASTUPD:=THLDATE;  (*  RESET  LAST  UPDATE  DATE  *) 

IF  LPAGE+1=RPAGE  THEN  BEGIN  OUT:=TRUE;  CLEARSCREEN;  GOTO  2  END; 

IF  LPA3E+1>RPAGE  THEN  ERROR (• LPAGE+1>RPAGE ♦. FATAL ) ; 

L3NUM:=2*(LPAGE  +  1)  : 

rbnum:=2*Rpage; 
maxblksinbuf:=bufsize  div  512; 

REPEAT 

WRITE( •♦• ) ; 

BLKSREAD:=BLOCKREAD(THEFlLE,EBUF'"tMAXBLKSlNaUFtRBNUM)  ; 
IF    lOHESULTOO    THEN    GOTO    i; 
IF    BlkSREADOO    THEN 
BEGIN 

IF    BL0CKWRlTE(THEFILE,E3UF*iBLKSREADtLBNUM)<>BLKSREAD    THEN    GOTO    1 
IF    lORESULTOO    THEN    GOTO    1 
ENo; 
lbnuvi:=lbnum+blksread; 
rbnuv):=rbnum+blksre:ad 

UNTIL  3LKSREAD=0; 

SETLASTBL0CK(2*{LPAGt.  +  l  +  FLEN6TH-RPAGE)  )  ; 
(*  COMPENSATE  FOR  GAP  FILLED  IN  *) 
WITH  PAGEZERO  00 
BEGlM 

FOR  i:=0  TO  COUNT-1  DO 

if  pagencid>=rpage  then  pagenci d : spagenc i  3- ( rpage-lpage ) +1 ; 
end; 
if  block^rite(thefilefpagezerot2»0)<>2  then  goto  1; 

out:=true; 

WRlTEL:\i; 

WRITELi4( 'THE  WORKFILE,  •1WFNA^1E. 

•.  IS  • .2*(LPAGE+1+FLENGTH-RPAGE) 1 •  BLOCKS  LONG.'); 
IF  LENGTH(3ACKFNAME)>0  THEN  WRITECTHE  BACKUP  FILE  IS  • , BACKFNAME ) ; 
CLOSE(ThEFILE.LOCK) ; 
GOTO  2; 
i:ERR0R( '/.WRITING  OUT  THE  FILE  •»  FATAL  )  ; 

2:enc; 


658  11  l:i  373 

659  11  i:i  878 

660  11  l:i  873  (*JTC  0  P  Y  F  I  L  E*) 

f^l  1-  1-J      1  SEGMENT  PROCEDURE  COPYFILE; 

6b2  12  1:d      1  VAR 

^tl  Yt  V\^               ^    STARTPAGE, STOPPAGE, STARTOFFSET.STOPOFFSET, 

III  to  ,:.      ^    l-EFTPART,PAGE,!\JOTrguLLS,THLREST,LMOVE:  INTEGER; 

66b  Id  i:d  10   DONE.ovFLw:  boolean; 

11^  \l  ijo  12   bufr:  packed  array  eo. .10233  of  char; 

III  :%  J:.^  ^^'^   startwark,stoPiViark:  packed  array  C0..7J  OF  char; 

668  12  i;j  332    FN:  STRING; 

669  12  1:D  573    F:  FILE; 

670  12  l:u  613 

671  12  2:D      1  PROCEDURE  ERRMARKER; 

672  12  2:0      0  3EGIN 

67^  \l  l\\  3^    ERRORMIMPROPER  MARKER  SPECIFICATION.', NONFATAL); 

675  12  2:0  41  end; 

676  12  2:0  54 

677  12  3:0      1  PROCEDURE  UNSPLITBUF; 

VtI  il  V?.               ^    '*  ^^^^^  T^^  BUFFER  3ACK  TOGETHER  AGAIN,  ♦) 

bf^  12  3.0     1  VAR  bogosity:  PTRTYPf; 

680  12  3:0      0  BEGIN 

ttl  \l  W)          °   moveleft(ebuf-ctherest3,ebuf'^ccursord,lmove); 

III  tl  ^:J  il    RCADJUsT(LEFTPART+i.CURS0R-(LEFTPART+1)); 

ill  1?  I  ^    BUFCOUnt:=BUFC0UNT+CURS0R-(LE!^TPART+1); 

685  12  V'\  II         rL^^r'^'^/^'^^  ^^°  ^""^'^  ^'^  *  '^O^  HAVEN'T  BEEN  GENERATED  *) 
Vt^  12  3.1  37    CHECKINDENT(CURSOR) ; 

686  12  3:1  if2   bo6osity:=leftpart+i; 

!fl  ^!  ^'^  '^^   checkindent{bogosity); 

688  12  3:0  54  end; 

689  12  3:0  66 

^^0  12  4:0  1  procedure  reaoerr; 

691  12  f:o  0  BEGIN 

Aq?  t?  ui^  °    ERR0R( 'MARKER  EXCEEDS  FILE  BOUNDS. ♦, NONFATAL) ; 

693  12  4:i  3t+    UNSPLIT3UFF; 

ill  J?  "^'^  ^^    CENTERCURS0R(TRASH, MIDDLE, TRUE); 

'II  J!  "^'^  '*°    EXIT(COPYFILE) 

°56  12  4:0  50  end; 

697  12  4:0  62 

6^Q  12  5:D  1  PROCEDURE  SPLITBUF;                                                          21^ 


o  o  *■> 


b9S  12  5:D  1  (*  SPLIT  THE  BUFFER  AT  THE  CURSOf^.   THEREST  POINTS  TO  THE  RIGHT  PART,  LMOVE 

7C0  12  b:n  1  IS  THE  LEJGTH  OF  THE  RIGHT  PART,  LEFTpART  POINTS  TO  THE  END  OF  THE  'LEFT 

701  12  5:D  1  PART',  AND  CURSOR  REMAINS  UNCHANGED.  *) 

702  X2  5:0  0  cEGIN 

703  12  5:i  0  TH£REST:=BUFSIZE-(BUFC0UNT-CURS0R) ; 

701  12  5:i  3  lmove:=biifcount-cursor+i; 

705  12  5:i  16  leftpart:=cursor-i; 

706  12  b:i  22  »10VERIGHT(EBJF'^CCURSOR],EBUF''CTHERESTJ, LMOVE) 

707  12  5:o  3i  end; 

708  12  5:0  46 

709  12  6:d  1  procedure  parsefn; 

710  12  6:D  1  VAR  I.LPTRiRPTRtCOMi^^A:  INTEGER; 

711  12  6:0  5  MARK:  STRING; 

712  12  6:o  0  BEGIN 

713  12  6:i  0  lptr:=poS( 'C'.fn) ; 

7m  12  6:i  15  IF  lptr=o  then 

715  12  6:2  20  begin  (*  WHOLE  FILE  *) 

716  12  6:3  20  startmark:=»       •; 

717  12  6:3  37  ST0PMARK:=  •  • 

718  12  6:2  m  END 

719  12  6:i  54  ELSE 

720  12  6:2  56  BEGIN 

721  12  6:3  56  RPTR :=P0S( • 3* tFN) ; 

722  12  6:3  71  IF  (RPTR=0)  OR  {RPTR<LPTR)  OR  (RPTR<>LENGTH( FN) )  THEN  ERRMARKER; 

723  12  6:3  91  MARK : =COPY (FN,LPTR+1 ,RPTR-LPTR-1 ) ;  (*  STUFF  BETWEEN  THE  BRACKETS  ♦) 

724  12  6:3  114  FN: =COPY ( FN* 1 ,LPTR-1 ) ; 

725  12  6:3  135  COMMA : =POS (» i • ,MARK ) ; 

726  12  6:3  148  IF  COMMA=0  THEN  ERRMARKER; 

727  12  6:3  155  I : =lENGTH ( MARK ) -COMMA ;  (*  SECOND  MARKER  PTR  *) 

728  12  6:3  163  MOy/ELEFT  (  MARKC  1  3«  STARTMaRK,  MIN(  8tC0MMA-l )  )  ; 

729  12  6:3  182  FIllCHAR ( STARTMARKCCOMMA-1 ].MAX ( 0 ,8- ( COMMA-1 ) ) , •  •); 

730  12  6:3  203  M0\/ELEFT{MARKCC0MMA+1  D»  ST0PMARK»MlN{  1 .8 )  )  ; 

731  12  6:3  222  FIlLCHAR  {  STOPMARKC  I  D,  r«1AX  (  0  ,  8-1 )  ,  ♦  ♦) 

732  12  6:2  239  END; 

733  12  6:i  239  FOR  i:=0  TO  7  DO  STARTMARKC I 3:=UCLC ( STARTMARKC I  3 ) ; 

734  12  6:i  275  FOR  i:=0  TO  7  DO  STOPMARK  C I  J : =UCLC ( STOPMARKC I D ) ; 

735  12  6:i  311  FOR  i:=l  TO  LEN6TH(FN)  DO  FNCI D: =UCLC ( FNC I D ) ; 

736  12  6:i  352  IF  ( ( POS (' .TEXT* , FN ) <>LENGTH( FN) -4 )  OR 

737  12  &:i  378  ( LENGTH ( FN )<=4 ) )  AND  ( FNC LENGTH ( FN )]<>♦.• )  THEN 

738  12  6:2  403  FN : =CONCAT ( FN » » . TEXT ' ) ; 

739  12  6:i  438  IF  FNC LENGTH ( FN )]=♦. '  THEN  T   ETE ( FN » LENGTH ( FN ) t 1) ; 
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PROCEDURE  STJFFIT(START,STOP:iNTrGER) ; 

(♦  PUT  THE  CONTENTS  oF  BUFR  INTO  EBUF.   OVFLW  IS  SET  TO  TRUE  WHEN  THERE  IS 

NO  MORE  ROOM  IN  THE  BUFFER,  *) 
VAR  AiVlOUMT:  INTEGER; 
BEGIN 

IF  STArt<=STOP  THEN 
BEGlrg 

AMOUNT :=ST0P-START+i; 

IF  CURSOR  +  AI«IOJNT  +  250(*SLOP*)>  =  THEREST  THEN 

3EGIN 

ERROR ('BUFFER  OVERFLOW, •, NONFATAL) T 

cursor:=leftpart+i; 

UNSPLITBUFFJ 
EXIT(COPYFILE) 

END 
ELSE 
BEGIN 

MOVELEFTIBUFRC  START  3,  EBUF-^C  CURSOR  3.  AMOUNT); 
CURSOR :=CURSOR+AMOUNT 
END 
END 

end; 

PROCEDURE  GETNEXT; 
BEGIN 

D0NE:=3LOCKREAD{F,bUFR,2.PAGE+PAGE)<>2; 
IF    lORESULTOO    THEN 
BEGIN 

errorcbad  disk  transfer  »,  nonfatal  )  ; 

cursor:=leftpart+i; 

unsplitbuf; 

EXIT(COPYFILE) 

End; 

WRITE(  •••) ; 

IF  NOT  DONE  THEN  NOTNULLS : =SCAN( -1024, <>CHR ( 0 ), BUFRC10233) +1024 

ELSE  notnulls:=o; 

PAGE:=PAGE+l; 

end; 

221 
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proced'jr::  chkovflw; 

b  c  G 1 1  \1 

IF  (STopOFFSET>=NOTf^JULLS)  AND  ( STOPPAGE<PAGE )  THEN 
dEGlJ 

STOPPAGE :=STOPpAGE+i; 
STOPOFFSET:=STOPOFFSET-N0TlMULLS; 

Efjo; 
end; 

procedure  findmarkers5 

(*  given  startmark  and  stopmark  find  out  their  page  numbers  and  offsets  *) 

VAR 

PZ:  HEADER; 

PROCEDURE  SEARCH(MNAME:NAME;VAR  OFFiPNUM:  INTEGER); 
VAR 

I:  INTEGER; 
BEGIN 
I  *  =0  ■ 

WHILE  (KPZ. COUNT)  AND  ( MNAMEOPZ.NAMEC  1 3)  DO  I:  =  I  +  l; 
IF  MNAMEOPZ.NAMECI3  THEN 
BEGIN 

ERROR( 'MARKER  NOT  THERE. • iNONFATAL ) ; 
UNSPLITBUFF; 
EXIT(COPYFILE) 
end; 
off:=pZ,poffsetci3; 
pnum:=pz.pagencid; 
if  pnum=0  then 
BEGIN  off:=off-i;  pnum:=i  end;  (*  kludge  to  maintain  compatibility  *) 

END; 

beginc*  findmarkers  ♦) 
startpage:=i;    startoffset:=o;   (*  default  values  *) 

stoppage: =32767;  STOPOFFSET: =32767; 

if  (STaRTMaRK<>»         •)  OR  (STOPMARKO*         •)  THEN 

8EGIl^J 

if  BL0CKREAD(F,PZ»2,0)<>2  THEN  READERR; 

IF  STARTMARKO'         '  THEN  SEARCH( STARTMARK , STARTOFFSET , STARTPAGE ) ; 

IF  STOPMARKO*         •  THEN  SEARCH! STOPMARK, STOPOFFSET. STOPPAGE ) 

END 
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SSI 

12 

1:4 

253 

855 

12 

i;3 

265 

85b 

12 

1:4 

269 

857 

12 

1:2 

273 

858 

12 

1:1 

277 

859 

12 

1:1 

301 

860 

12 

1:1 

303 

861 

12 

1:1 

313 

862 

12 

i:n 

320 

rUQ 


^tGIi'J 


PROMPTi,ii^E:  =  '  copy:  from  what  FILECMARKERf  markers?  •; 
REPEAT 

prompt; 

REAOLN(Fi\|)  ; 

IF  L^NGTH(FN)=0  THEN  EXIT ( COPYFILr ) ; 
PARSEpN; 
RESET(F.FfNl)  ; 

PROl*'iPTLIME:  =  »  copy:  file  not  present.  FILENAME?  •: 
UNTIL  IORESULT=0; 

promptline:=»  copy*;  prompt; 

splitbjf; 

findmarkers; 

page:=startpage; 

GETNeXT; 

WHILE  (START0FFSET>=N0TNULLS)  AND  NOT  DONE  DO 
BEGIN 

chkovflw; 

startoffset:=startoffset-notnulls; 
getnext; 
end; 
if  (st0ppage<page)  and  ( stopoffset<notnulls )  then 

STUFFIT{START0FFSET,MIN(N0TNULLS-1,ST0P0FFSET-1)) 
ELSE 

STUFFIT(START0FFSET,N0TNULLS-1) ; 

WHILE  ((STOPPAGE>=PAGE)  OR  ( STOPOFFSET>=NOTNULLS ) )  AND  NOT  DONE  DO 

BESlM 

chkovflw; 
getnext; 

IF  (ST0PPAGE<PAGE)  AND  ( STOPOFFSET<NOTNULLS)  THEN 
STUFFIT(O.MIN(NOTNULLS-1»STOPOFFSET-1) ) 

ELSE 

stuffit(o.notnulls-l) 

end; 

IF  lORESJLTOO  THEN  ERR0R(»DISK  ERROR. ♦ .NONFATAL) ; 
UNSPLITBUF; 

CENTERCURSORC TRASH, MIDDLE, TRUE) ; 
CLOSE(F); 

end;  223 


oo  -1: 


dd>3 

12 

i:g 

346 

8<^'+ 

12 

i:n 

0<4S 

855 

13 

i:o 

1 

866 

13 

Hi 

1 

867 

13 

i:d 

1 

868 

13 

i:o 

2 

869 

13 

2:d 

1 

370 

13 

2:o 

3 

871 

13 

2:0 

3 

872 

13 

2:d 

3 

873 

13 

2:0 

0 

874 

13 

2:1 

0 

875 

13 

2:2 

5 

876 

13 

2:3 

5 

877 

13 

2:3 

28 

878 

13 

2:4 

30 

879 

13 

2:5 

30 

830 

13 

2:6 

47 

831 

13 

2:5 

66 

832 

13 

2:6 

68 

883 

13 

2:7 

85 

884 

13 

216 

104 

885 

13 

2:7 

106 

886 

13 

2:8 

123 

887 

13 

2:7 

142 

888 

13 

2:8 

144 

889 

13 

2:9 

144 

890 

13 

2:9 

151 

891 

13 

2:9 

167 

892 

13 

2:9 

184 

893 

13 

2:9 

198 

894 

13 

2:9 

212 

895 

13 

2:9 

224 

896 

13 

2:9 

237 

897 

13 

2:9 

250 

898 

13 

2:9 

265 

899 

13 

2:9 

283 

900 

13 

2:9 

299 

901 

13 

2:9 

316 

902 

13 

2:9 

318 

903 

13 

2:9 

364 

(*iTE  rj  V  I  1"!  0  ;J  M  C  'J  T*) 
SEGMENT  PR0CE:DURE  E'JVIRONMENT  ; 

l:  INTEGER; 

PROCEDURE  WRITEDATE(THEDATE:DATEREC)  ; 

(*  write  out  (in  text)  the  date.  please  note  the  restraint  involved  in 

not  putting  in  my  birthday!  (rsk)  *) 
var  t:  string; 

3EGIN 

WITH  THEOATE  do 
BEGIN 

IF    VIONTH=0    THEN    WRITE  (•  NONE •  ) 
ELSE 
BEGIN 

if  (m0nth=12)  and  (day=25)  then 
writecchristwasm 

ELSE 

IF  (M0NTH=1)  AND  (DAY=1)  THEN 

WRITE ('NEW  YEARS') 
ELSE 

IF  (MONTH=10)  AND  (DAY=3l)  THEN 

WRITE( 'HALLOWEEN' ) 
ELSE 
BEGIN 

CASE  MONTH  OF 


1: 

t:  = 

'JANUARY' ; 

2: 

t;  = 

'FEBRUARY' ; 

3: 

t;  = 

'MARCH'; 

4: 

t:  = 

•APRIL' ; 

5: 

t:  = 

'MAY'; 

3  • 

t:  = 

♦JUNE' ; 

7: 

t:  = 

'JULY' ; 

a: 

t:  = 

'AUGUST' ; 

9: 

T:  = 

'SEPTEMBER' 

101 

!T:  = 

'OCTOBER' ; 

111 

:t:  = 

'NOVEMBER' ; 

12; 

;t:  = 

•DECEMBER' 

END  J 

WRITE(T 

t',   DAY); 

904   15     iilN    3^,5 
^05   13     2:5    5'3 


E'JO; 


90'-^  13  2:}  <,21  END; 

909  15  2:0  446 

qt?  H  ^:^'  ^  PROCEDURE  ERASLIC; 

:i:t  ^l  l''^  1  VAR  i:  integer; 

^■^^  13  3:o  0  BEGIN 


913   13     3:1      0 


wRITlC  'rio); 


lit  II  |:J  /^  ^^^OR  i:=l  io  10  00  WRITE(CHR(3SPCE)); 

916  13  3:0  43 

III  II  ?:;?  1  PROCEDURE  300L(3:300LEAN); 

yia  13  4:0  0  BEGIN 

920  13  III  3J  J^  8  Jf^J  WRITECTRUEM  ELSE  .RITE( 'FALSE.  ); 

921  13  4:o  34  END; 

922  13  4:0  52 

III  II  I:?,  I  FUNCTION  SlTBOOL:  BOOLEAN; 

;f=  ^i  i:°  2  V'^R  CH;  char; 

925  13  5:0  0  BEGIN 

lit  II  m  0  ERASEio;  ch:=uclc{Getch); 

III  ]l  5:3  35  WRITECT  OR  pM; 

931  13  5-i  «^  ^^^  TRASH:=0  TU  5  DO  WRITE ( CHR ( BS )) ; 

q?i  Vx  l:i  ^^  ch:=uclc(getch) 

932  13  5;2  90  END; 

III  Yi  V^  ^^  ^^    C^='T'  THEN 

lit  II  V^  ^°'*  BEGIN 

III  II.  V.l  ^^"^  WRITE(»TRUE   »); 

9^7  1^  I'J  ^^°  getbool:=true 

937  13  5:2  120  END 

938  13  5:1  123  ELSE 

939  13  5:2  125  BEGIN 


9'+0   13     5:3    125 


iRiTECFALSE  '); 


III  II  1:1  1^1       getbool:=false 

^'+2  13  5.2  141        ENO: 

943  13  5;0  144    END; 

9'^'+  13  5:0  ISO 


325 


945  13  6:j               5         FU;\ICTlOM    GETINT:     ITxITEGER; 

S'+S  13  aiD               i          VAR 

9*+?  13  o:j           5           ch:char; 

94.3  13  o:c           i+           ^:    intcIger; 

949  13  &:0      0    BEGIN 

950  13  6:1      0      ERASElO; 

951  13  6:1      2      i\i:  =  0; 

952  13  6:1      5      REPEAT 

953  13  6:2      5        REPEAT 

951+  13  6:3    5       ch:=getch; 

955  13  6:3  12          IF  NOT  (CH  IN  C • 0 • . . ' 9 • t CHR ( SP ) t CHR ( CR ) D ) 

956  13  6:3  31            THEN  WRITE( •«'tCHR(BELL)»CHR(BS)) ; 

957  13  6:2  60        UNTIL  CH  IN  C • 0 • • . • 9» » CHR ( SP ) t CHR { CR ) 3 ; 

958  13  6:2  31        IF  C^    IM  C«0'..*9»D  THEN 

959  13  6:3  96          BEGIN 

960  13  6:4  96            VJRITE(CH); 

961  13  6:^  104            IF  N<1000  THEN  N:=N*10+ORO (CH) -ORD ( • 0 ' ) 

962  13  6:3  117          end; 

963  13  6:1  120      UNTIL  CH  IN  LCHR { SP) t CHR (CR ) D; 

964  13  6:1  129      GETINT:=N!  WRITE('   M 

965  13  6:0  144    END; 

966  13  6:0  160 

967  13  7:D      1  PROCEDURE  TA3SET; 

968  13  7:0      1  VAR 

969  13  7:D      1    X»I,NUv|jlMES:  INTEGER; 

970  13  7:D      4 

971  13  8:0      1    PROCEDURE  SETIT ( CHlCHAR ) ; 

972  16  6:D      2    (*  SET  THE  TABSTOP  ACCORDING  TO  THE  CHARACTER  PASSED  *) 

973  13  8:0      0    BEGIN 

974  13  a:i      0      WITH  PAGEZERO  DO 

975  13  8:2      0        CASE  CH  OF 

976  13  8:2      3          'N't'-*:  BEGIN  CH:='-';  TABSTOPCX 3: =NONE ;  END; 

977  13  8:2  19          »L':      TABST0PCX3:=LEFTJUST; 

978  13  8:2  32       'R':    tabstopcx]:=rightjust; 

979  13  8:2  45          'D':      TABSTOPC X 3 : =DECIMALSTOP 

980  13  e:2  54        ENQ; 

981  13  8:1  142      WRITl(CH); 

982  15  3:0  150    END; 

983  13  8:0  162 

984  13  7:0      0  3EGIN 

985  13  7:1      C    WITH  PagEZEKO  DO 


9oo  16  712  n  ^EGT 

^^^  13  7:3  0  CLEA^SCREE 

l^^  1^  7:3  i  _          wRiTtlLJt 

990  13  7:3  f  '^^"^    ^^^S:    <RIGHT,LEFT    VECTORS>       C(OLtt       CN(0    RdGHT    L(EFT    D(ECIMAL    STOPD       <ETX>« 

5^1  13  7-3  97  ^RlTELfM; 

Hi  It  l'^  ^^^  ^^^    ^•=°    TO    SCREENlvlDTH    DO 

993  13  7:!+  im  C^SE    TA3ST0PCI2    OF 

11"^  13  7:^  124  none:  writec-m; 

11^  J^  ^  =  '+  13'+  leftjust:  writecl'); 

QQ7  •'^  ■^'^'^  RIGHTJUST:  WRITE(«RM; 

997  13  7:4  15(+  DECIMALSTOP:  WRITECDM 

998  13  7:4  162  enO; 

999  13  7:3  187  x:=o; 

JSS?  H  ^'^  ^^°  G0T0XY(4,4);  i^RITE( 'COLUMN  1*  •  )  ? 

1001  13  7:3  213  REPEAT 

JSnx  J^  I*'^  ^^^  G0T0XY{12,4);  WRITE  ( X  +  1 : 3)  ; 

1003  13  7:4  226  30T0XY(X.2); 

1004  13  7:4  233  CH:=UCLC(GETCH)5 

Tnn!  ^^  I:'!  ^'^^  MUMTIMES:=G£TNUM;  (*  ALSO  SETS  COMMAND  *) 

1SS7  16  I'll  2?3  IF^CH  IN  C'N.,'D',«L'.'R',.-.3  THEN  SETIT(CH) 

1008  13  7-5  277  ^IF  CH=«C'  THtN 

1009  13  7:6  262  BEGIN 

tSi^?  ^^  ^'"^  ^^^  GOTOXY(12,4); 

IQl?  J^  7!!  ^nl  X:=MAX(0»MIN(GETINT,SCREENWIDTH+1)-1); 

xui<i  ii  7.6  309  £(\jQ 

1013  13  7:b  309  ELSE 

1015  1?  7.'^  xoi  ^"^  COMMAND  =  LEFT  THEN  X:=MAX  ( 0  ,X-NUMTlMES ) 

XUX3  10  f,z>  320  ELSE 

1017  ^3  7;7  III  IF^COMMANQrRlGHT  THEN  X: =MIN(X+NUMTIMES,SCREENWIDTH) 

iSli  II  713  374  UNTIL  CH^C^R^iET^xM '"  ''    ^^HR(ETX),.  •.,  THEN  WRITE  (CHROELL,  ,  ; 

1021  II  7II  III  rf,D;  •  =  ***'  ^*  ^°  ^^  °°^*^  ''*'-'-  °^T  ^LL  OF  THE  WAY!  *) 

1022  13  7:0  384  end;"" 

1023  13  7:0  400 

1024  13  9:0  1  PROCEDURE  WRITEMENU; 

1025  13  9:0  0  3EGIN 

1026  13  9:1  0  WITH  PagEZERO  00                                                            poh 


'?'. 


28 


1027 

1028 

1029 

1050 

1051 

1032 

1033 

103i+ 

1035 

1036 

1037 

1038 

1039 

lOtO 

lOtl 

10'+2 

1013 

lOttf 

lO'+S 

1046 

10'+7 

lOfS 

10*t9 

1050 

1051 

1052 

1053 

1054 

1055 

1056 

1057 

1058 

1059 

1060 

1061 

1062 

1063 

1064 

1065 

1066 

1067 


13 

15 

13 

15 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 


9:2 
9:3 


9: 
9: 
9: 

■*   • 

9: 

9: 

9: 

9: 

9: 

9: 

9: 

9: 

9:3 

9:3 

9:3 

9:2 

9:o 

9:o 

io:d 

io:o 

io:i 

10:2 


10 
10 
10 
10 
10 
10 
10 
10 
10 
10 
10 
10 
10 


:3 

:4 
:5 
:5 
:5 
:5 
:<+ 
:3 

•  1 

•  sj 

:3 

:4 

:5 
:5 


10:6 
10:5 
io:& 
ro:5 


0 
0 

6 
39 
72 
113 
164 
21U 
254 
238 
321 
327 
397 
467 
523 
583 
663 
669 
669 
682 
1 
0 
0 
0 
0 
9 
9 
38 
93 
144 
156 
156 
191 
203 
221 
221 
234 
248 
256 
258 
291 


Ql&I 

WR 

WR 
wR 
WK 
WR 
WR 
WR 
WR 
WR 
WR 
WR 

WR 


iteln 

ITE( 

ITZi 

IT£( 

ITE( 

ITE{ 

ITE( 

ITE( 

ITE( 

ITELiM; 

ITlLiM 

ITELN 

ITELN 
f 

WRiTELNi 
END? 


A(UTO    INDENT 
FdLLINS 
L(EFT    MARGIN 
RdGHT    MARGIN 
P(ARA    MARGIN 
C(OMMANO    CH 
S(ET    TA3ST0PS 
T(OKEN    DEF 


300L(AUT0INDENT) ; 
BOOL(FILLING) ; 
WRITELN(LMARGIN+1)  ; 
WRITELNCRMARGIN+l) ; 
WRITELN(PARAMARGIN+1) ; 
WRITELN(RUNOFFCH) ; 
WR ITELN! 
BOOL(TOKDEF) ! 


AVAILABLE.' ) ; 
AND  •» 


(BUFCOUNTt»  BYTES  USED.  • .BUFSI2E-BUFC0UNT+1 . • 
(»THERE  ARE  'tLPAGE,'  PAGES  IN  THE  LEFT  STACK, 
FLENGTH-RPAGE*'  PAGES  IN  THE  RIGHT  STACK.'); 
(»YOU  HAVE  'iRPAGE-LPAGE-l.'  PAGES  OF  ROOM.*, 
AND  AT  MOST  »,(BUFCOUNT  OIV  960)+l,»  PAGES  WORTH  IN  THE  BUFFER.') I 


end; 


PROCEDURE  WRITEINFO; 
BEGIN 

WITH  PAGEZERO  DO 
BEGIN 

IF  SOEFINED  OR  TDEFINED  THEN 
BEGIN 

WRITELNC     patterns:'); 

if  tdefinec  then  writec     <target>=  "•  .target:  tlength,  "")  ; 
if  sdefined  then  writec,  <subst>=  •"  .substring:  slength,  "")  ; 

writeln;  writeln; 

END; 
IF  COUNT>0  THEN  WRITELNC     MARKERS:'); 
WRITE('   •); 
FOR  l:=0  TO  COUNT-1  DO 
3EGIN 

WRITEC    •); 

IF    PAGEN:n  =  -l    THEN 

WRITEC     •) 
ELSE 

IF  PAGENcIJ<=LPAGE  then  WRITEC<')  ELSE  WRITEO'); 

write(name:i:i  J) ; 


1063 

106:? 

1073 

1071 

1072 

1073 

1074 

1075 

1076 

1077 

1078 

1079 

1080 

1031 

1082 

1083 

lOStf 

1085 

1086 

1087 

1088 

1089 

1090 

1091 

1092 

1093 

1094 

1095 

1096 

1097 

1098 

1099 

1100 

1101 

1102 

1103 

not 

1105 
1106 
1107 
1108 


13 

13 

15 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

15 


iO 
IG 
10 
10 
10 
10 
10 
10 
10 
10 

10; 
i: 
l: 
i; 
i: 
i; 
i: 
i: 
i: 
i: 
i: 
i: 
i: 
i: 
i: 
i: 
i: 
i: 
i: 
i: 
i: 


:'4 
:3 
:3 

•  -^ 

%   -?, 

•  O 

:3 

52 

:o 
;o 

:o 

;i 

\2 

:3 

3 
3 
3 
3 
3 
3 
tf 

5 

5 
5 
5 
5 
5 


1:5 
1:5 


1 
1 
1 
1 
1 
1 
1 
1:6 


307 
328 
3^0 
3  5d 
362 
369 
395 
425 
468 

486 
0 
0 
0 
0 
3 
54 
61 
63 
65 
74 
74 
86 
107 
110 
150 
152 
135 
149 
163 
185 
207 
229 
245 
245 
247 
250 
253 
255 
257 
266 


IF  (lOCOUriT-l)  AND  (d  +  l)  MOD  5  =  0)  THEN 
SElGrj  WRITELN;  WRITEC   •)  EfvjD 

EijD; 


END 


WKlTtLfj; 
wRITELn; 
WRITE( • 
WRITE(  •  ; 

^ritec  (revision  • , revisiow, • ) . ' ) 

End; 


CREATED  •) 
LAST  UPDATED 


WRITEDATE(CREATED) : 
•);  WRITEDATE(LASTUPD) ; 


BEGIN 

WITH  PagEZERO  do 
BEGIN 

cleaRScreen; 

promptline:=  »  environmen 
PROMPT;  needprompt:=:true; 

WRITEMENU; 
WRITEINFO; 

G0T0XY{ LENGTH (PROMPTLINE) 
REPEAT 

ch:=uclc{GETch) ; 

IF  not  (CH  IN  C'A»i 'C't 

then 
begin  errorcnot  opti 

ELSE 

CH  OF 

BEGIN 


T:  C0PTI0NS3  <SPACEBAR>  TO  LEAVE'; 

fO) ; 

•F»»»L»t»P»t»R»»»S»t»T»«»  •«CHR(CR)3) 

0N», NONFATAL) ;  PROMPT}  END 


CASE 

•A': 
•F»: 

♦R» : 
ipi . 

•c: 
•s»: 


G0T0XY(18 
G0T0XY(18 
G0T0XY(18 
G0T0XY(18 
GOTOXYdS 
G0T0XY(18 


.1) 
«2) 
♦  3) 
t4) 
.5) 
«6) 


BEGIN 
BEGIN 
BEGIN 
BEGIN 
BEGIN 
BEGIN 

TABSET?  (*  NEW  SCREEN  DISPLAYED  ♦) 

CLEARSCREEN; 

PROMPT; 

WRITEMENU; 

WRITEINFO; 

GOTOXY(LENGTH(PR0MPTLlNE)f0) 
END; 


autoindent:=getbool  end; 
filling:=getbool  end? 
lmargin:=max{o»getint-1)  end; 
rmargin:=max(0,getint-1)  end; 
paramargin:=max{o,getint-i)  end; 
read(runoffch)  end; 


329' 


'^'^>0 


CiJ( 


1109  13  1:5  263  'T':  BEGlfj  bOTOX  Y  ( 18 » S )  ;  TOKDEF :  =GETBOOL  END 

1110  13  1:5  230  end; 

llil  13  11'^  330          30T0XY(LLf\IGTH(HR0,-'^PTLINE)  ,0)  ; 

1112  13  1:3  339  UNTIL  CH  IfJ  L*     ♦tCHR(CR)J; 

1113  13  1:3  355  redisplay; 
lll'f  13  1:2  358      end; 

1115  13  i:c  358  end; 

1116  13  1:0  378 

1117  13  1:0  378 

1118  13  1:0  373 

1119  13  1:0  373  (*$TP  U  r  S  Y  IM  T  A  X*) 

1120  m  1:0  1  SEGMENT  PROCEDURE  PUTSYNTaX; 

1121  in  1:d  1  vAR 

1122  m  1:d  1    D0tDl»D2»8LK.PTRtCOLON:  INTEGER; 

1123  in  1:d  7    T.C:pACKED  ARRAY  CO. -2]  OF  CHAR; 

ii2t  m  i:d  11   buf.-packed  array  co. .10233  of  char; 

1125  !<+  1:D  523    F:  FILE; 

1126  1*+  1:D  563 

1127  14  2:D  1  PROCEDURE  PUTNUM; 

1128  14  2:0  0  BEGIN 

1129  m  2:1  0    MSG:=«SYNTAX  ERROR  #';  PUTMSG; 

1130  14  2:1  25    WRITE(USERINF0.ERRNUM,»,  TYPE  <SP>»); 

1131  14  2:0  56  end; 

1132  14  2:0  63 

1133  14  1:0  0  BEGIN  (♦  PUTSYNTAX  *) 

1134  14  1:1  0    WITH  USERINFO  DO 

1135  14  1:2  13  BEGIN 

1136  14  1:3  13  OPENOLD(Fi'*SYSTEM, SYNTAX') ; 

1137  14  1:3  38  IF  lORESULTOO  THEN  PUTNU^I 

1138  14  1:3  44  ELSE 

1139  14  1:4  48  3EGIN 

1140  14  1:5  48  IF  ERRNUM<=109  THEN  BLK:=2 

1141  14  1:5  55  ELSE 

1142  14  1:6  60  IF  ERRNUM<=131  THEN  BLK:=4 

1143  14  1:6  69  ELSE 

1144  14  1:7  74  IF  ERRNUM<=156  THEN  3LK:=6 

1145  14  1:7  33  ELSE 

1146  14  1:8  88  IF  ERRNUM<=254  THEN  BLK:=8 

1147  14  i;6  97  ELSE  BLK:=10; 

1148  14  1:5  105  IF  3L0CKREAC(F,3UF»2»3LK)<>2  THEN  PUTNUM 

1149  14  1:5  123  ELSE 


ii5u  m  i:fa  127  BCGirj 

1151  m  1:7  1^7  IF  3Ufco3=chr(Dle:)  then  ptr:=2  else  ptr:=o; 

1152  14  1:7  143  DO:=ERRiJUM  DIV  100;  (*  CONVERT  ERROR  NUMBER  TO  CHARACTERS  ♦) 
1155  m  1:7  150  Di:=(ERRNUM-D0*100)  DIV  10; 

llbf  14  1:7  l&l  D2:=ERRNUM  MOD  10; 

1155  m  1:7  l&a  TC0::=CHR(DC  +  ORD( 'O' )  )  5  TC1]:=CHR(D1  +  ORD(»OM ) ; 

1156  14  1:7  1S2  TC2D:=CHR(D2  +  0RD( '0« )  )  ; 

1157  14  1:7  189  REPEAT 

1158  14  1:8  189  FILLCHAR(C.3i 'O') ; 

1159  14  1:8  196  C0L3n:=SCAN(MAXCHAR,=«:»,BUFCPTR3) 5 

1160  14  1:8  209  s^OVELEFTCBUFCPTR:, CC3-C0LQN3, COLON)  ; 

1161  14  1:6  220  colon:=colon+ptr; 

1162  14  1:8  225  PTR:=SCAN(MAXCHAR,=CHR(E0L)»BUFCpTR3)+PTR+3 

1163  14  1:7  238  UNTIL  (T=C)  OR  { BUFC PTR :=CHR ( 0 ) ) ! 

1164  14  1:7  258  IF  BUFCPTRD=CHR ( 0 )  THEN  PUTNUM 

1165  14  1:7  266  ELSE 

1166  14  1:8  270  BEGIN 

1167  14  1:9  270  M0VELEFT(BUFCC0L0N+l3»MSGCl3»(PTR-C0L0N>-4) ; 

1168  14  1:9  286  MSGC03:=CHR(MIN(68.(PTR-COLON)-f)) ;  (*  R-  REQUIRED  ♦) 

1169  14  1:9  302  HOWIE;  CLEARLINE  ( 0 )  !  WRiTEtMSGt*.   TYPE  <SP>»); 

1170  14  1:8  341  END 

1171  14  1:6  341  END 

1172  14  1:4  341  END(*  IF  lORESULTOO  *); 

1173  14  1:3  341  SHOWCURSOR; 

1174  14  1:3  344  REPEAT  UNTIL  GETCH='  •; 

1175  14  1:3  353  erRBlk:=o;   errsym:=o;   errnum:=05    c*     only  yell  ONCEM!   *) 

1176  14  1:2  365  eno(*  with  userinfo  *) 

1177  14  1:0  365  END(*  pUtsYNTAX  *); 

1178  14  1:0  392 

1179  14  1:0  392 

1180  14  1:0  392  (*$TE  OITCORE   -   BASIC  COMMANDS*) 

1181  14  l;C  392 

1182  15  1:D  1  SEGMENT  PROCEDURE  EDITCOREJ 

1183  15  i:d  1 

1184  15  1:D  1  (*  CORE  PROCEDURES.   EXECUTE  THESE  COMMANDS  UNTIL  EITHER  A  SET  ENVIRONMENT 

1185  15  1:0  1    comes  along  or  a  quit  command,  *) 

1186  15  i:d  1 

1187  15  i:c  1 

1188  15  i:d  1 

1189  15  2:D  1  PROCEDURE  NEXTCO^MAND!  FORWARD;                                                231 

1190  15  2:D  1 
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1191 

15 

3:d 

1 

1192 

15 

3:g 

0 

1193 

lb 

3:i 

0 

1194 

15 

3:i 

13 

1195 

15 

3:i 

^^ 

1196 

15 

3:o 

^l 

1197 

15 

3:o 

42 

1193 

15 

4:d 

1 

1199 

15 

'tlD 

1 

1200 

15 

4:o 

1 

1201 

15 

f  :o 

0 

1202 

15 

f:i 

0 

1203 

15 

i+n 

45 

120'+ 

15 

4:1 

52 

1205 

15 

'+:i 

55 

1206 

15 

^:i 

91 

1207 

15 

^:i 

108 

1208 

15 

'f:2 

113 

1209 

15 

4:i 

114 

1210 

15 

4:2 

119 

1211 

15 

4:3 

124 

1212 

15 

4:i 

128 

1213 

15 

4:i 

145 

12m 

15 

4:o 

145 

1215 

15 

4:o 

162 

1216 

15 

5:d 

1 

1217 

15 

5:d 

1 

1218 

15 

5:d 

1 

1219 

15 

5:o 

0 

1220 

15 

5:i 

0 

1221 

15 

5:i 

3 

1222 

15 

5:i 

82 

1223 

15 

5:i 

89 

1224 

15 

5:i 

92 

1225 

15 

5:i 

129 

1226 

15 

5:i 

146 

1227 

15 

5:2 

151 

1228 

15 

5:3 

151 

1229 

15 

5:3 

155 

1230 

15 

5:2 

156 

1231 

15 

5:i 

159 

proclouRl  fixdireictiom; 

r  EGIN 

IF  COMmaND=FORwARDC  THEN  DIREC TION : = ' > •  ELSE  DIRECTION :=•<' ; 
HOME;  WRITE(DIRECTION) ;  (*  UPDATE  PROMPT  LINE  *) 
SHOkJCUrsOR;  NEXTCOMMAND 

end; 

PROCEDURE  3Ai-iISH; 
VAR 

cm:  CHAR; 
BEGIN 

promptline:='  banish:  to  the  L(EFT  or  right  <esc>»; 

PROMPT;  needprompt:=true; 

showcursOR; 

REPEAT    CH:=UCLC(GETCH)    UNTIL    CH    IN    C 'L* » 'R* «CHR (ESC) 3  $ 

IF    CHOCHRCESC)    THEN    BEGIN    GOTOXY{7fO);    ERASETOEOL( 7« 0 )    END; 

if  ch=»l'  then 

putpagescleftstack) 
else 

IF  CH='R'  then 

putpages(RIGhtstack) ; 

IF  CH<>CHR(ESC)  THEN  CENTERCURSOR ( TRASH. MIDDLE, TRUE) 5 

nextcommand 
end; 

procedure  next; 

VAR 

ch:  char; 

BEGIN 

promptline:= 
'  next:  f(ORwards,  bcackwards  im  the  file;  sctart.  ecnd  of  the  file.  <esc>» 
PROMPT;  needprompt:=true; 

SHOWCURSOR; 

REPEAT  CH:=UCLC(GETCH)  UNTIL  CH  IN  C 'F* , » B» » * S» , • E» , CHR ( ESC ) D ; 

IF  CH<>cHR(ESC)  then  begin  GOTOXY{5f0);  ERASETOEOL ( 5 » 0 )  END; 

IF  CH=»F'  THEN 
BEGIN 

PUtpAGES(LEFTSTACK) ; 
GEtpAGES(RIGHTSTACK) 
END 
ELSE 


1232  15  5:2  lol  ir  CH='B'  THE:^ 

Jf^R  J-^  ^•'^  1°°  PUTPAGES(RIGHTSTACK)  ; 

ip^?  1H  ^'^  ^'^^  SETPQGLSCLEFTSTACK) 

x-iOS  lb  5:3  171  £N3 

1237  15  5:2  174  ELSE 

]m  ^i  ^'^  ^^°  If'  CH=.S»  THEN 

1239  15  5:h  131  BEGIN 

Jpit?  Vi  i:^^  ^^^  ^^^I^^  LPAGE>0  DO 

1241  15  5:6  188  3EGIN 

1243  is  V'l  itl  ^GOTOXY(5,0);  ERASETOEOL ( 5 . 0 ) ; 

ipau  1=  =  ®  cursor:=i; 

1245  15  V-l  oSi  PUTPAGES(RIGHTSTACK); 

1?4A  1^  ^:I  o°^  GETPAGES(LEFTSTACK) 

1<;46  15  5:6  2C6  END; 

Jpal  J^  ^'^  ^^^  cursor:=i 

1248  15  5:4  211  ^^q 

1249  15  5:3  214 


ELSE 


THEN 


1250  15  5:4  216  IF  CH=»E 

1251  15  5:5  221  BEGIN 

^m      \l  lit  ii^  ^^IL^  RPAGE<FLENGTH  DO 

i*i33   15  5:7  230  BEGIN 

1255  II  sig  oaS  SOTOxy(5,0);  ERASETOEOL ( 5, 0 >  ; 

1256  IS  I'-l  12  cursor:=bufcount-i; 

1257  is  S^a  oil  PUTPAGLS(LEFTSTACK); 

1258  1?  s.i  o^n  GETPAGES(RIGHTSTACK) 
1258  15  5:7  250  FND5 

1259  IS  S'£L  -^KC  t.lMU« 

1260  is  i;5  til  ^^CURS0«:=BUFCOUNT-l; 

iasa  i?  sli  i?°  1^^CH<>CHR,ESC,  mNCENTERCURSOR(TRASH.«IDDLE.TRUE., 

1263  15  5:0  277  END; 

1264  15  5:0  298 

1265  15  6:D  1  PROCEDURE  COPY; 

1266  15  6:o  0  BEGIN 

^261  II  v.]  a?  PR0^PTLINE:='  copy:  B(UFFER   FtROMFILE   <ESC>«; 

,ila  J!  ^'^  ^^  PROMPT;  NEEDPROMPT:=TRUr; 

1269  lb  6:i  1+8  REPEAT 

^57?  ^l  °'^  '^^  CH:=UCLC(GETCH); 

^27?  IS  "iJ  ^^  ^"^^^L  ^^    I'^  C'B','F'.CHR(ESC)3;                                               ooo 

1272  13  b:i  83  IF  CH=»3»  THEN                                                                   2^3 
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1275 
i27H 
1275 
1276 
1277 
1278 
1279 
1280 
1281 
1282 
1283 
1284 
1285 
1286 
1237 
1288 
1289 
1290 
1291 
1292 
1293 
129<t 
1295 
1296 
1297 
1298 
1299 
1300 
1301 
1302 
1303 
1301+ 
1305 
1306 
1307 
1308 
1309 
1310 
1311 
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15 
15 
15 
15 
15 
15 
15 
15 
15 
lb 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
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15 
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15 
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o 

S 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 

r 
O 

6 
6 
6 
6 

6 

7 
7 
7 
7 
7 
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3 
3 
3 
3 

5 

16 
7 

;d 
:8 

7 

:6 
:6 
7 
16 
7 
6 
6 
6 
6 
6 
6 
6 
6 
6 
5 
2 
1 
2 
1 
1 
0 

a 

:D 
0 

1 

0 

0 

D 


38 

ca 

103 
1C9 
129 
131 
15^+ 
159 
159 
164 
16'+ 
167 
167 
170 
185 
198 
213 
215 
226 
233 
240 
245 
248 
255 
260 
263 
272 
279 
282 
282 
2B4 
293 
296 
298 
316 
1 
0 
0 
2 
14 
1 


IF  NOT  COPYOK  OR  (  ( bUFCOU^JT  +  COPYLENGTH  +  10>COPYSTART ) 

AND  (CODYSTART>=BUFCOUNT) ) 
THEN  ERROR(  •  i:\lVALID  COPY  .♦  t  NONFATAL  ) 

-:lse 

IF  BUFC0UNT+C0PYLENGTH>=BUFSIZE  then  ERR0R(»N0  ROOM' tNONFATAL) 
ELSE 
BEGIN 

IF  COPYLINE  THEN 
3EGIN 

getleading; 
cursor:=linestart 
END; 
mover  IGHT(EBUF'*C  cursor  3  iEBUF"CCURS0R  +  C0PYLENGTH3fBUFC0UNT-CURS0R+l) 

IF  (copystart>=cursor)  and  <copystart<bufcount)  then 

M0VElEFT(EBUF'>CC0PYSTART+C0PYLENGTH3,EBUF''CCURS0RD.C0PYLENGTH) 

else 

M0VELEFT(EBUF'^CC0PYSTART3»EBUF'*C CURSOR D,C0PYLENGTH)  ; 

BUFCQUNT : =bufcount+copylength  X 

READJUST(CURSOR»COPYLENGTH) ; 

CHECKINDENT(CURSOR) ;       (♦  CHECK  THE  BORDER  FOR  TWO  DLE'S  *) 

lastpat:=cursor;        <*  for  equalc  *) 
cursor :=cursor+copylength! 

CHECKINDENT(CURSOR) ;   (*  ...  AND  ALSO  CHECK  THE  OTHER  BORDER  *) 

GETLEADING; 

CURSOR:=MAX(CURSORtSTUFFSTART) ; 

CENTERCURSOR( TRASH. MIDDLE. TRUE) 
END; 
END  (*  CH='B'  *) 
ELSE 

IF  CH='F'  THEN  EXIT ( EDITCORE ) ; 

showcursor; 
nextco^imand; 
end(*copy*) ; 

procedure  dump; 

5EGIN 

NEXTC0i\1l«iAN0; 
END(*    dump    *) ; 

PROCEDURE    FIND;     FORIiIARD; 


1311  15  arc  1 

1315  15  9:D  L  procedure  INSERTIT;  FORWARD; 

1316  15  ilO  1 

1317  15  10:j  1  PROCEDURE  JUMP; 
1313  lb  10:D  1  VAR  CM:  CHAR; 

1319  15  10:D  2 

1320  15  11 :d  1  PROCEDURE  JUMPMARKER; 

1321  15  H:D  1  vAR 

1322  15  h:d  1   mustredisp:  boolean; 

1323  15  11:j  2          i:     INTEGER; 

132H  15  11:D  3         MfgAME:    PACKED    ARRAY    tO.,73    OF    CHAR; 

1325  15  11:D  7 

1326  15  12;D  1  PROCEDURE  SHUFFLE; 

1327  15  12:0  0  BEGIN 

1328  15  12:0  0   (*  must  redisplay  the  screen  *) 

1329  15  12:1  0   imustredisp:=true; 

1330  15  12:1  ^   with  pagezero  do 

1331  15  12:2  f  BEGIN 

1332  15  12:3  4  CLeaRLINE ( 0 ) ; 

1333  15  12:3  8  WRITECLEAPINGM  ! 

I33f  15  12:3  25        IF  PAGENCn<=LPAGE  THEN 

1335  15  12:1  tfO  WHILE  {LPAGE>0)  AND  (PAGENC 1 30-1 )  DO 

1336  15  12:5  60  BEGIN 

1337  15  12:6  60  GOTOXY(7»0);  ERASET9E0L ( 7. 0 ) ; 

1338  15  12:6  70  CURSOR:=i; 

1339  15  12:6  73  PUTPAGES(RIGHTSTACK) ; 

1340  15  12:6  77  GETPAGES(LLFTSTACK) 

1341  15  12:5  78  END 

1342  15  12:3  ai  ELSE 

1343  15  12:4  85  WHILE  (RPAGE<FLENGTH)  AND  ( PAGENC I 30-1 )  DO 

1344  15  12:5  107  BEGIN 

1345  15  12:6  107  GOTOXY(7,0);  ERASETOEOL ( 7. 0 ) ; 

1346  15  12:6  117          cursor:=bufcount-i; 

1347  15  12:6  122  PUTPAGES(LEFTSTACK); 

1348  15  12:6  126  GETPAGES(RIGHTSTACK) 

1349  15  12:5  127  END 

1350  15  12:2  130  END 

1351  15  12:0  132  END; 

1352  15  12:0  148 

1353  15  11:0  0  BEGIN                                                                       ^>^. 

1354  15  11:1  0   mustredisp:=false;                                          ^^" 


1355  15  11:1  3  WITH  PAGeZERO  JC 

1356  15  11:2  5  3E&I  i 

1357  15  11:3  3  &ETNAf^ii(  •  JU'^P    TC '  i  MfjAFJlE )  ; 

1358  15  11:3  19  IF    ^^fvlAMEO'  •    THEN 

1359  15  11:4  36  SEGPJ 

1360  15  11:5  36  i:=o; 

1361  15  11:5  39  iJHILE    (KCOUNT)    AND    ( \1NAMEONAMEi:  1 3)    DO    I:  =  I  +  l; 

1362  15  11:5  65  IF    MNAMEONAMEC I J    THEN 

1363  15  11:6  78  ERRORCNOT    THERE. ».  NONFATAL) 

1364  15  11:5  92  ELSE 

1365  15  11:6  97  BEGIN 

1366  15  11:6  97  {*  IF  TEXT  POINTED  TO  ISN'T  IN  THE  8UFFER1  LOAD  IT  IN  *) 

1367  15  11:7  97  IF  PAGENCIDO-l  THEN  SHUFFLE; 

1368  15  11:7  111  IF  PAGENCIDO-l  THEN  ERROR (• MARKER  ALL  MESSED  UP. • , NONFATAL) 

1369  15  11:7  148  ELSE 

1370  15  11:8  153  CURS0R.*=P0FFSETCID; 

1371  15  11:7  162  GETLEADING; 

1372  15  11:7  165  CURSOR:=MAX(CURSOR,STUFFSTaRT) { 

1373  15  11:7  174  CENTERCURSOR ( TRASH t MIDDLE » MUSTREDISP) 

1374  15  11:6  161  end; 

1375  15  11:4  184  END; 

1376  15  11:2  184  end; 

1377  15  11:0  184  end;  (*  JUMPMARKER  *) 

1378  15  11:0  200 

1379  15  10:0  0  3egin  (♦  jump  *) 

1380  15  10:1  0  promptline:='  jump:  bceginning  E(N0  mcarker  <ESC>»{ 

1381  15  10:1  44  PROMPT; 

1382  15  10:1  47  neecprompt:=true;  <*  need  TO  redisplay  edit:  promptlinei  *) 

1383  15  10:1  51  repeat 

1384  15  10:2  51  CH:=UCLC(GETCH) ; 

1385  15  10:2  63  IF  Ch='B»  THEN 

1386  15  10:3  68  BEGIN 

1387  15  10:4  68  cuRsor:=i; 

1388  15  10:4  71  GETLEADING; 

1389  15  10:4  74  cursor:=stuffstart; 

1390  15  10:4  77  CE.-iTERCURSOR{TKASH»l. FALSE) 

1391  15  10:3  32  END 

1392  15  10:2  65  ELSE 

1393  15  lu:3  87  IF  cH='E'  THEN 

1394  15  10:4  92  5EGIN 

1395  15  \0:5  92  CURSOR : =BJFC0UNT-1 ! 


Itlj       J5    loll  107  ,.  ^^'^"^^^-^f^^ORC  rRASti,SCRcLNHEIGHT-l, FALSE)  ; 

1338   io    10:3  107  ELsr'^ 

Japn   :?  JSi'l  J^^  IF  CH=«|V,.  THEN  JUMPMARKER 

illl   ^l  in  ?  '''  -^'^  ^"^  CH<>CHK(ESC)  THEN  ERR^AITJ 

^unl      1-  ^n'i  ^^^         ^^^^^  ^C'^  I'^  C«d«,'E%V.r,CHR(ESC)]); 

I'+O.i   1-0  10:1  151    fMEXTCO-^r^ANO; 

1^03   15  10:0  153  end; 

I'^O'i  15  io;o  i&a 

lJ+05   15  13:d  1  PROCEDURE  DEFMACRO; 

l'+06   lb  13:o  0  BEGIN 

nil       ]l  J^ix  .S    ^^^^  PAGEZERO  DO  IF  FILLING  AMD  NOT  AUTOINDENT  THEN 

i-tuo  ID  16,5  10      BEGIN 

IJjOg  15  13:^  10                    3LANKCRT(1); 

l^^ll  1^  ^V.u  l""                    THEFlXER(CURSOR,REPEATFACTOR,TRUE); 

IUIP  1^  ^i:t  !°                    CENTERCURSOR(TRASH, MIDDLE, TRUE); 

iHitj  15  13:3  30               END 

nil  li  IV-f  !?         ^""^^    ERRORCINAPPROPKIATE    ENVIRONMENT' , NONFATAL)  ; 

IHIH  15  13.1  ^n         C0PY0K;=FALSE; 

I'+IS  15  13:i  68         SHOWCUr-^SOR; 

I'flS  15  13;i  71         NEXTCOViMANO; 

i^+i?  15  13:0  73  end; 

I'fie  15  i3:o  86 

mi  ^l  ^'^'°  ^    PROCEDURE    SETMARKER; 

l'+20  15  m;D  1    LABEL    li 

I'+si  15  I'+ro  1  var 

!aox  ^i  ^"^'^  ^       I'SLOT:  integer; 

iIpI  II  m^.  ^       mname:  packed  array  co..7d  of  char; 

IHiif  15  lifio  0    BEGIN 

l'*25  15  m:i  0         WITH    PAGEZERO    00 

1^*26  15  1^:2  0              BEGIN 

mi  '^^  ^^'^  °              needprompt:=truE5 

taoa  .^  J!*'^  '*                    COunT:=MIN(20, COUNT); 

nin  ^t  J^'^  ^^                    I""    COUNT=20    THEN 

l'+30  15  m:if  23                         BEGIN 

mi  1.^  ^'**^  2^                              BLANKCRTd); 

l'+35  15  IV'l  Q?                                         WRITE(CHR{ORDCAM+I),t)     SnAMECID,'          •); 

i^36  15  ll\l  ^11                                  ,,l',     ''^'^    mo.-O    THEN    WKITELN;                                                                            33^ 


#^  o*  •--* 


I'+^T  15  l'+J5  11''  'MSiI  = 

m33  1:.  14:5  116  'r^A^K'^  0\/ERFLO,^.   WHICH  ONE  TO  REPLACE?  (TYPE  IN  THE  LETTER  OR  <SP>)  »; 

1439  15  14:5  190  P'JTf-iSG;  CH :  =UCLC  ( GETCH )  ; 

mij  15  14:5  205  CENTERCUR30R(TRASHiN1I0DLE,TRUE)  ; 

1441  15  14:5  215  IF  CH  IN  r.A'.,«T«D  THEN  SLOT : =QRD { CH ) -ORD ( • A • ) 

1442  15  14:5  236  ELSE 

1443  15  14:6  241  uOTO  1! 

1444  15  14:4  243  ENO 

1445  15  14:3  243  ELSE 

1446  15  14:4  245  SL0T:=C0UNT; 

1447  15  lf:3  250  GETNAMl  (  •  SET' ,  wiNAME )  ; 
1446  15  14:3  261  IF  M^IA^1E<>•         '  THEN 

1449  15  14:4  279  BEGIN 

1450  15  14:5  279  FOR  i:=0  TO  COUNT-1  DO 

1451  15  14:6  294  IF  NAMEC I :=MNAME  THEN  SL0T:=I; 

1452  15  14:5  317  NAMECSLOT 3:=MNAME; 

1453  15  14:5  327  POFFSETCSLOT J:=CURSOR ; 

1454  15  14:5  335  PAGENCSL0T3:=-1 ; 

1455  15  14:5  344  IF  SLOT=COUNT  THEN  COUNT : =C0UNT+1 

1456  15  14:4  354  EN05 

1457  15  14:2  359  END; 

1458  15  14:i  359  i:END; 

1459  15  14:i  378 

1460  15  15:D  1  PROCEDURE  SETSTUFFJ 

1461  15  15:D  1  VAR  CH:  CHAR; 

1462  15  15:0  0  BEGIN 

1463  15  15:i  0  PROMPTlINE:=«  set:  E(NVIR0NMENT  M(ARKER  <ESC>M 

1464  15  15:i  40  PROMPT;  NEEDPROMPT : =TRUE ; 

1465  15  15:i  47  REPEAT 

1466  15  15:2  47  CH : =UCLC ( GETCH ) ; 

1467  15  15:2  59  IF  CH='E«  THEN  EXiT ( EDITCORE ) 

1468  15  15:2  68  ELSE 

1469  15  15:3  70  IF  CH='M'  THETyl  SETMARKER 

1470  15  15:3  75  ELSE  IF  CH<>CHR(ESC)  THEN  ERRwAIT; 

1471  15  15:i  39  UNTIL  CH  IN  C » E » . ♦ M' ' CHR ( ESC ) 3 ; 

1472  15  15:i  111  SHOWCURSORi 

1473  15  15:i  114  NEXTCOviMAND; 

1474  15  13:0  116  E.ND(*  SETSTUFF  ♦); 

1475  15  15:0  130 

1476  15  16:D  1  PROCEDURE  VERIFY; 

1477  15  \6:0  0  3EGIN 


1^76 

lb 

1d:i 

kJ 

m79 

15 

1d:i 

10 

1480 

13 

16:  i 

13 

1431 

15 

16  :o 

13 

1482 

15 

1 6 :  u 

28 

1483 

15 

17:d 

1 

1484 

15 

i7:D 

1 

1485 

15 

i7:q 

1 

1486 

15 

17:d 

3 

1437 

15 

i7:a 

0 

1488 

15 

I7:i 

J 

1489 

15 

i7:i 

68 

1490 

15 

i7:i 

75 

1491 

15 

i7:i 

73 

1492 

15 

i7:i 

81 

1493 

15 

I7:i 

34 

1494 

15 

17:2 

84 

1495 

15 

17:2 

91 

1496 

15 

17:3 

101 

1497 

15 

17:4 

101 

1498 

15 

17:5 

106 

1499 

15 

17:6 

106 

1500 

15 

17:6 

116 

1501 

15 

17:6 

123 

1502 

15 

17:5 

149 

1503 

15 

17:3 

149 

1504 

15 

17:2 

149 

1505 

15 

17:3 

151 

1506 

15 

17:3 

162 

1507 

15 

17:4 

164 

1508 

15 

17:5 

184 

1509 

15 

17:6 

184 

1510 

15 

17:6 

212 

1511 

15 

17:6 

219 

1512 

15 

17:6 

223 

1513 

15 

17:6 

233 

1514 

15 

17:5 

241 

1515 

15 

I7:i 

241 

151b 

15 

i7:i 

254 

1517 

15 

17:2 

261 

1518 

15 

17:3 

261 

CCi^JT cIKCuRSO^CTR ASH,  :>U DOLE,  TRU£)  ; 

showcuksor; 
^\iextco^/!ma^jd 

Elf^jD    (*    VlFUFY    *) ; 

PROCEDURE  XMaCRO; 
yAR 

SAVEC.l:  INTEGER! 

SAVr:PACKEO  ARRAY  C 0 . . MAXSTRIMG D  OF  CHAR; 

3EGIW 

pnnillo^^^^*^*  exchange:  text  C<3S>  a  CHARD  C<ESC>  ESCAPES;  <ETX>  ACCEPTS3'; 
PROMPT;  NE£DPROMPT:=TRUe;  •  h«-  tri  J  , 

SHOWCUrsOR; 

savec:=cursor; 
i:=o; 

REPEAT 

ch:=getch; 

IF  maptocommand(ch)=left  then 

BEGIN 

IF  (CURSOR>SAVEC)  THEN 
BEGIN 

i:=i-i;  cursor:=cursor-i;  (♦  decrement  both  ptrs  *) 
EBUF*ccuRSOR::=sAVEcn;  {♦  restore  buffer  *) 

WRITE{CHR(BSPCE)  ♦EBUF'^C  CURSOR], CHRCBSPCE)); 

END 

END 
ELSE 

IF  CH=CHR(E0L)  THEN  BEGIN  ERRWAIT;  SHOWCURSOR  END 
ELSE 

IF  NOT  (CH  IN  CCHR(ETX).CHR(ESC)])  AND  ( EBUF'^CCURSORDOCHR  (EOL)  )  THEN 
BEGIN 

IF  NOT  (CH  IN  C •  •..♦*•:)  THEN  CH:=»?»; 
SAVEC  I  3:=EBUF'^C CURSOR  D; 
E8UF'^[:CURS0RD:=CH; 

i:=i+i;  cursor:=cursor+i; 

WRITE(CH) 

end; 

UNTIL  CH  IN  CCHR{ETX),CHR(ESC) J; 
IF  CH=CHR(ESC)  THEN 

BEGIN  pla 

cu^sor:=savec;  ^^^ 
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ii3i^i  lb  17:  j  264  f-'io^/rLt;FT(SAVc:i;o:»E8jF'^ccu^saR:.i) ; 

1520  15  17:3  272  SHC/.CUR30R:  iilR  iTt.  ( SAVE :  I  )  ;  SHQWCURSOR 

l3il  15  17:2  2d7  Eno; 

1522  15  17:1  290  iJEArcO-l-'iANfj; 

i523  15  17:3  2':J2  rND  (*  X'ACRJ  *); 

1524  15  17:0  6C'6 

1525  13  18:D  1  PROCEDURE  ZAPIT; 

1526  15  18:o  0  ^EGIiM 

1527  15  18:i  0  IF  ABS(lASTPAT-CJRSOH)>80  ThEM 
1520  15  18:2  8  BEGl^i 

1529  15  18:3  8  PRDMPTlINE:= 

1530  15  18:3  11  '  WARNING!  YOU  ARE  ABOUT  TO  ZAP  MORE  THAN  80  CHARSt  DO  YOU  WISH  TO  ZAP?  (Y/N)'5 

1531  15  18:3  92  PROMPT; 

1532  15  18:3  95  NEEQPROMPT: =TRUE ? 

1535  15  18:3  99  IF  UCLC ( GETCH) <> ' Y'  THEN 

1534  15  is:**  113  3EGIN 

1535  15  18:5  113  SHOWCURSOR; 

1536  15  18:5  116  NEXTCOMMAND ! 

1537  15  18:5  118  EXIT(ZAPIT) 

1538  15  18:4  122  END! 

1539  15  18:2  122  ENDS 

1540  15  18:i  122  IF  0KT0DEL(MIN(CURS0KtLASTPAT),MAX(CURS0R»LASTpAT))  THEN 

1541  15  18:2  143  BEGIN 

1542  15  18:3  143  COPyLlNE: =FALSE ; 

1543  15  18:3  147  READJUST ( MIN ( CURSOR .LASTPAT )» -A3S< CURSOR-LASTPAT) ) ; 

1544  15  18:3  162  IF  c JRS0R>LASTpAT  THEN 

1545  15  18:4  167  '^^lOVELEFT  ( EBUF'^CCURSOR  D  i  EBUF'^CLASTPAT  3»  BUFCOUNT-CURSOR ) 

1546  15  18:3  176  ELSE 

1547  15  18:4  178  MQ\/ELEFT  ( EBUF"ELASTPAT3,  EBUF'^ECURSOR  :,BUFC0UNT-LASTPAT  )  ; 
1543  15  18:3  187  BUpCOUNT :=3UFC0UNT-ABS ( CURSOR-LASTPAT) { 

1549  15  18:3  195  CURSOR : =LASTPAT ; 

1550  15  18:3  198  CEfJTERCURSOR  ( TRASH ,  MIDDLE .  TRUE )  i 

1551  15  18:2  208  END? 

1552  15  18:i  203  SHOrtCURsOR; 

1553  15  18: 1  211  NEXTCOMVlAND 


u  « 


1554  15  18:a  213  END? 

1555  15  18:o  226 

1556  15  18:0  226  (*$TI  N  S  E  R  T    C  0  i^  M  A  N  D*) 

1557  15  18:o  22b 

1558  15  9:D      1  PROCEDURE  INSERTIT; 

1559  15  9:0      1  CONST 


1560 

15 

9: ;: 

1 

Ib61 

lb 

9:  J 

i 

1562 

15 

31') 

1 

1563 

lo 

9:j 

4 

1564 

13 

9:u 

10 

15b5 

15 

9:d 

io 

1566 

15 

9:d 

3T 

1567 

15 

19:d 

1 

156b 

15 

19  :d 

1 

1569 

15 

i9:a 

1 

1570 

io 

19:d 

1 

1571 

15 

19:d 

1 

1572 

15 

i9:o 

0 

1573 

15 

i9:i 

0 

1574 

15 

I9;i 

3 

1575 

15 

I9:i 

11 

1576 

15 

i9:i 

19 

1577 

15 

i9:i 

30 

1578 

15 

i9:i 

33 

1579 

15 

19:2 

42 

1580 

15 

19:3 

42 

1581 

15 

19:3 

67 

1582 

15 

19:3 

70 

1583 

15 

19:3 

72 

1584 

15 

19:2 

76 

1535 

15 

19:2 

76 

1586 

15 

i9:i 

76 

1587 

15 

i9:o 

94 

1588 

15 

i9:o 

106 

1589 

15 

2o:d 

1 

1590 

15 

2o:d 

1 

1591 

15 

2o:d 

1 

1592 

15 

2o:d 

1 

1593 

15 

2o:d 

1 

1594 

15 

2o:d 

1 

1595 

15 

2o:d 

2 

1596 

15 

2o:o 

0  : 

1597 

15 

2o:i 

0 

1598 

15 

20:2 

0 

1599 

15 

20:2 

3 

1600 

15 

20:2 

22 

FUDgEFaCT0R  =  1J  ; 

THEREST,LEFTPART,.SAVtBUFCOU-v|T:  PTRTYPE; 

CLEaREu,^AR(JCD,OK,W0TEXTYET,EXITPR0MPT,FIRSTLINE:  BOOLEAN! 
SPACES, LW0\/E,X,LI.JE.E0LQIST,RJUST:  L^TEGER; 

context:   packed  array  ccMAxsTRKjea  OF  char; 


PROCEDURE  SLAMRI5HT; 

(*  MOVE  (SLAivi)  THE  PORTIQM  OF  THE  EBUF'"  TO  THE 
THE  CURSOR  SO  THAT  THE  LAST  NUL  IN  THE  FILE 

e:3uf'*C3Ufsized.  therest  poimts  to  Tl 

TEXT.  *) 
BEGIN 

GETLEAdING; 

THEREST :=BUFSIZE-(3UFC0UNT-CURS0R); 

lmove:=bufcount-cursor+i; 

M0VERIsHT(EBUF-CCURSORD,EBUF'^CTHEREST3,LMOVE) 
GETLEADING;  (*  SET  BLANKS  ♦) 

IF  therest-cursor<maxstring  then 

BEGIN 


RIGHT  OF  (AND  INCLUDING) 
(EBUF'^CBUFCOUNTD)  is  NOW  AT 
BEGINNING  OF  THE  RIGHT-JUSTIFIED 


ERR0R( 'NO  ROOM 

showcursor; 
nextcoi^mand; 

EXIT(INSERTIT) 

end; 
{♦  optional  indentation  *) 

EBUF^CTHEREST-2D:=cHR(DLE) ; 


TO  INSERT. '.NONFATAL) 


END; 


E3UF'*CTHEREST-ia:=CHR(aLANKS+32) 


PROCEDURE  WRAPUP; 

{*  GIVEN  THE  NEW  VALUE  OF  THE  CURSOR  (ONE  PAST  THE  LAST  VALID  CHARarTFR 
INSERTED  INTO  THE  BUFFER),  PUT  SACK  TOGETHER  THE  JwO  HA^Jes  2f  JSe 

?HE  EdJtoR  CAN  COPE^tJ'"  ''  ''''  ''°'''  ''"  '^'''^  '°  '"'^'^  ^^^  ^"^  '' 
VAR  PTR:  PTRTYPE; 

lngth:  Integer; 
3EGIN 

with  pagezero  00 

IF  NOTEXTYET  AND  (NOT  FIRSTLINE)  AND 

((NOT  FILLING)  OR  AUTOINDENT)  AND  (  CHOCHR  (  ESC )  ) 
THEN  (♦  WE  WANT  THE  BLANKS  BEFORE  THEREST  *) 
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16Q1 

lo 

<iU:3 

s^D 

1602 

15 

20m 

It 

loOi 

15 

20:^ 

iO 

1604 

la 

20:4 

46 

1605 

15 

20  : 3 

hi 

1606 

15 

20  ;i 

63 

1607 

15 

2o:i 

74 

loOa 

15 

2o:i 

85 

1609 

15 

2o:i 

100 

1610 

15 

20:2 

100 

1611 

15 

23:3 

116 

1612 

15 

20:1 

135 

1613 

15 

20:1 

153 

1611+ 

15 

20:1 

156 

1615 

15 

20:1 

165 

1616 

15 

20:1 

172 

1617 

15 

20:1 

186 

1618 

15 

20:0 

186 

1619 

15 

20:0 

200 

1620 

15 

2i:d 

3 

1621 

15 

2i:d 

4 

1622 

15 

2i:d 

4 

1623 

15 

2i:d 

4 

162tf 

15 

21:0 

0 

1625 

15 

21:1 

0 

1626 

15 

21:1 

3 

1627 

15 

21:2 

10 

1628 

15 

21:3 

10 

1629 

15 

21:3 

17 

1630 

15 

21:3 

53 

1631 

15 

21:2 

62 

1632 

15 

21:1 

62 

1633 

15 

21:2 

64 

1631 

15 

21:3 

75 

1635 

15 

21:4 

75 

1636 

15 

21:5 

81 

1637 

15 

21:6 

81 

1636 

15 

21;  6 

121 

1639 

15 

21:6 

130 

16^+0 

15 

21:5 

130 

16'+1 

lb 

■'1:4 

134 

-3JFC0Ui\]T:=3jrC0UNT  +  2; 
THLRr;ST:=TMEf<EST-2;     LMOVil :  =LM0VE  +  2  ; 

CURS0r^:=SCAi\j(-l«IAXCHAR,=CHR(E0L).EBUF*i:CURS0R-l3)+CURS0R; 

END; 

M0VELEft(E3UF"CTHERESTD,EBUF'"C CURSOR D.LMOVE)  ! 
READJUst(LEFTPART+i,CURS0R-(LlFTPART+1) ) ; 
BUFC0UrNjT:=3UFC0UNT  +  CURSCR-(LEFTPART  +  l)  ; 
WITH  PagEZERO  do 

IF  FILLING  AND  'MoT  AUTOINDENT  AND  ( CH=CHR  { ETX )  )  THEN 

BEGIN  THEFIXLR(CURSORfl«FALSE);  FIRSTLINE:=FALSE;  FINDXY ( X, LINE )  END; 

upscreen(firstlii\ie,exitprorpt  or  (  ch=chr  (esc  ))*  line  )  ; 

getleading; 

cursor:=max(cursor,stuffstart)  ; 

lastpat:=leftpart+i; 

C0PY0K:=TRUE;  copystart:=lastpat;  copylength:=cursor-lastpat; 

NEXTCOMiwiANO 

end; 

function  check(value:integer):  300lean; 

(*  VALUE  IS  THE  POTENTIAL  VALUE  OF  THE  CURSOR.   IF  IT  IS  NOT  IN  LEGAL 
RANGE  THEN  CHECK  IS  FALSE.   THIS  FUNCTION  ALSO  WARNS  THE  USER  IF 
S/HE  IS  GETTING  TOO  CLOSE  TO  OVERFLOWING  THE  BUFFER  ♦) 

BEGIN 

check:=tRue; 

if  valje<=leftpart  then 

BEGIN 

ok:=false;  check:=false; 

ERRORCNO  INSERTION  TO  BACK  OVER. ♦, NONFATAL ) ;  PROMPT; 
GOTOXY(X,LINE) 

END 
ELSE 

IF  value>=therest-maxchar  then 

BEGIN 

IF  NOT  WARNED  THEN 
dEoIN 

ERROR( 'PLEASE  FINISH  UP  THE  INSERTION », NONFATAL ) ;  PROMPT; 

g0t0xy(x,line) ; 

a'Arned:=true 
end; 
if  value>therest-fudgr  ctor  then 


lo'+d  15  2i:b  143             ;:E3Ifg 

loll       ?^  p|.'^  !''a  LRR0RC6UFFER  OVERFLOW  !!!!»,  WONFATAL)  ; 

l&^o  la  21:5  175            £Nj 

16'+7  15  <;i:3  17d        c-r^jn 

X6'+8  15  21:0  175  ci^jD; 

1649  15  21:0  138 

1650  15  22:d      1  PROCEDURE  SPACEOVER; 

1652  15  l^             i  ^ar'^Icwx^I^teger;'''''"  ''''''  '''  ''''  '''"'"  ^^^^°  ^^^  ^^'^^^«  *» 

lo53  15  22:0      0  SEGIN 

1^^^^  .^^  ?o*^      °    ^f"  CH=CHR(HT)  THEN 

lo55  15  22:2      5      3EGI^J 

1656  15  22:3      5        NEwx:=X+l; 

1658  is  ?f*^  ^^        ^^^^  PAGEZERO  DO 

1659  Is  22:3  35        SPACES-=NeSx-J°''^''^''''^'''°^^'  ^""^    (NEWX<SCREENWIDTH)  DO  NEWXl=NEWX+l ; 

1660  15  22:2  36      END 

1661  15  22:1  /+3    ELSE 

1662  15  22:2  45    spaces:=i; 

\lll  \l  ^oii  '^^  ^^   check(cursor+spaces)  then 

166^  15  22:2  60              BEGIN 

All  \l  ll\l  ^°                   FIllCHAR(EBUF-CCURSORD»SPACES,'     M; 

\lly  .1  11'^  ^^              cursor:=cursor+spaces 

1667  15  22:2  69      END 

1668  15  22:0  75  end; 

1669  15  22:0  90 

\tVl  II  V"'^              ^    PROCEDURE  FIXUP;  FORWARD; 

1671  15  23:u      1 

1672  15  24:o      1  PROCEDURE  ENDLINE; 

167^  \l  W'l              \    ^*  ll^^l'    i[  ^^^^^    ^'^^    ^°    ^^^T  INSERTED  ON  THE  CURRENT  LINE,  THEN  CONVERT 

1675  is  ll'n              ]            ?h^  °^  I^^  SPACES  TO  BLANK  COMPRESSION  CODES.   THEN  INSERT  AN  <EOL>  INTO 

^67^  is  ll':o          i    Indentation'^*)"'"'  ''  '"'  appropriate  number  of  spaces  for  the 

1677  15  2^:0      0  BEGII\j 

J^7o  il  ?^*^      °    '-^^^H  PAGEZERO  DO 

I079  15  24:2      0      BEGIN 

isl?  is  11:1               °        ^^    NOTEXTYET  THEN  FiXUP; 

168?  Ts  iZ:l  J        E3UF-CCURSQRa:=CHR{E0L);                                                 ^,^ 

1662  15  24.3  11        if  AUTOINDENT  THLN  GETLEADING                                             ^'^^ 
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IfeSi  15  2^:6  15,  tlLst 

Iba^  15  24:1  ^1  jF    FILLIl^lG    ThCN 

IbaS  15  c^:5  ki^  BEGI.N 

168S  15  2H:a  26  GETLEADInG; 

1687  15  k^la  29  IF  EdUF'^c  STUFFSTART  J  =  CHR  ( EOL )  THEN  (*  EMPTY  LINE  *) 

1688  15  24:7  36  BLANKS : =PARAMARGIM 

1689  15  2'+:&  36  ELSE  BLANKS :  =LMARGIN 

1690  15  2^:5  43  END 

1691  15  24:4  48  ELSE  BLANKS:=0; 

1692  15  24:3  53  IF  CHECK ( CURSOR+BLANKS+1 )  THEN 

1693  15  24:4  64  3EGIN 

1694  15  24:5  64  FILLCHAR  ( EBUF'^C  CURSOR  +  1 3*  BLANKS  ♦  '  M! 

1695  15  24:5  72  CURSOR :=CURS0R+3LANKS+1 

1696  15  24:4  75  END? 

1697  15  24:3  79  NOTEXTYET : =TRUE 5 

1698  15  24:2  83  END; 

1699  15  24:o  83  END; 

1700  15  24:0  96 

1701  15  25:0  1  PROCEDURE  BACKUP; 

1702  15  25:D  1  (*  IF  THE  CH  IS  A  BACKSPACE  THEN  DECREMENT  CURSOR  BY  1.   IF  THIS  WOULD 

1703  15  25:D  1  RESULT  IN  BACKING  OVER  AN  <EOL>  OR  A  BLANK  COMPRESSION  CODE*  THEN  FALL 

1704  15  25:d  1  INTO  THE  CODE  FOR  A  <DEL>  (ALSO  CHANGING  THE  CH  TO  <DEL>  FOR  COMMUNICATION 

1705  15  25:D  1  TO  THE  OUTER  BLOCK)   ♦) 

1706  15  25:D  1  VAR  PTR:  PTRTYPE; 

1707  15  25:0  0  BEGIN 

1708  15  25:i  0  IF  CH=CHR(0C1)  THEN 

1709  15  25:2  5  BEGI:M  GETLEADING;  IF  CHECK  ( LINESTART )  THEN  CURSOR:=LINESTART  END 

1710  15  25:i  18  ELSE 

1711  15  25:2  20  IF  (CH=CHR(BS))  AND 

1712  15  25:2  25  N3T<  ( EBUF'"CCURS0R-2:i=CHR  ( OLE )  )  OR  ( EBUF'^CCURSOR-l  3=CHR  ( EOD  )  )  THEN 

1713  15  25:3  44  3E3IN 

1714  15  25:4  44  IF  CURS0R<LEFTPART+2  THEN  0K:=FALSE  ELSE  CURSOR :=CURS0R-1 5 

1715  15  25:3  64  ENQ 

1716  15  25:2  64  ELSE 

1717  15  25:3  66  3E3IN  (*  A  <DEL>  OR  EQUIVALENT  *) 

1718  15  25:4  66  CH : =CHR ( DEL )  ;  (*  TELL  THE  CRT  DRIVER  THAT  THE  LINE  HAS  CHANGED  *) 

1719  15  25:4  71  SETLEADING; 

1720  15  25:4  74  IF  CHECK  ( LIi^ESTART-1 )  THEN  CURSOR :  =LINESTART-1 ; 

1721  15  25:4  88  JOTEXTYET : =FALSE ;  (*  THANK  YOU  SHAWN!  *) 

1722  15  25:5  92  EiO 

1723  15  ''5:0  92  END; 


1724  15  25  :c  lj'+ 

1725  15  23:.-:  1  pRQCEQijRr  FiXUh''; 

172?  It  It'i  I  '*  Tw-^r^M''^  INDENTATION  SPACES  INTO  BLANK  COMPRESSION  CODES,  AND  MOVE 

1701   t?  o.'"  ^  ^^'^    CJRRENT  LINE  AHOUND  ACCORDINGLY  *) 

lf^5       lo  23:o  0  3EGIN 

till      I-  it'''  ^  '*  ^^^5T  COMPRESS  THL  CURRENT  LINE  *) 

1731   1^  IV'^  I  ^!i!''^t:cuRS0R]:=CHR(EOL);  (*  FOOL  GETLEADING  *) 

x/oi   13  23.1  4  GlTLEAqiNG; 

J733   15  IV'l  J  ^^o^J^^^=  ^  ^^^'^    <*  °*^'  ^°  '''•J^  If^  <°L-E>  «  AS  IT  STANDS  *) 

1-rll  15  23U  23  eJ°'^-^^^'^^^^'^'==^"r^'^'^-"TART3,E3UF''ELlNESTART  +  2D,CURS0R-STUFFSTART) 

Vl\l  \i  IV'^  ^^  ^^  CHECK(CURS0R  +  2-BYTES)  THEN 

I7^q  1^  l^'^  ^^  CURS0R:=CURS0R-(BYTES-2); 

17^0  is  23!  J  ^1  ^^EBUF'^CliNESTART::=CHH(DLE);  EBUF-CLINESTART  +  n:=CHR(32^BLANKS)  ; 

IT^+l  15  23:0  90 

\lll  1^  26:d  1  PROCEDURE  INSERTCH; 

17^^^  15  26-D  \  '*  i^M^  PROCEDURE  INSERTS  A  SINGLE  CHARACTER  INTO  THE  BUFFER.  IT  ALSO 

1745  ll  2&-n  \  HMH^^"  *^^  °^  ^'^^  CONTROL  CODES  (EOL,BS,DEL)  AND  BUFFER  OVER-  AND 

17'6  is  26:'^  0  BEGIN         '    ^°^°^'I°'^S-   INSERTCH  IS  CALLED  BY  THE  CRT  HANDLER  *) 

1747  15  26:i  0  REPEAT 

W^l  is  26;f  I  ?h;!gETCH;'*  "'  "'°'''  "'"'  INVALIDATE  THE  CURRENT  CHARACTER  HAVE  OCCURED  *) 

i75?  \l  ll'.l  ll  V    MAPTOCOMMAND(CH)=LEFT  THEN  CH:  =CHR  ( BS )  : 

1752  i?  26:i  59  BEGIN^^^  ^'^  CSP.HTtEOL  ,  BS,  DEL  ,  ETX^ESC  ,  DCl  3  THEN 

i754  is  IV'l  ll  \l    "^11^^    *^°  ^"^>  *^^  HANDLED  IN  THE  BODY  OF  INSERTIT  ♦) 

i755  is  ll\l  jI  ll^f^^^^^^    ^^    CSP,HT:  THEN  SPACEOVER 

mt  il  oV.l  ^^  ^^  ORD(CH)=EOL  THEN  ENDLINE 

i.  t -J  f  X3  £.b,o  81  ELSE 

i759  ll  lilt  109  END    ''  ^'^^''^  ''  CDCl,BS,DELD  THEN  BACKUP; 

1760  15  26:2  109  ELSE 

i762  is  26-U  JiJ  ^^^l''     '*  ^  CHARACTER  TO  INSERT!  *) 

1763  is  26':*:  III  Vf    NOyEXT;ET°?HEN'F;;up/'''  ''^"'"  '*    ''  NON-PRINTING  CHARACTERS  *, 

17t.4  15  26:4  130  IF  CHECK  ( CURSOR  +  1 )  AND  OK  THEN                                            O^:- 


1765  15  26:5  lli  iEGIi^j 

1766  15  26:6  m3  [nIQTEIXTYET  :  =rALSE ; 

1767  13  26:6  147  lBuF'^:  CUHSOK  J :  =CH ; 
1766  15  26:6  151            CURSOR : =CURS0R+1 
1769  15  26:5  152          ^[jQ; 

177C  15  26:3  156      END; 

1771  15  26:i  156   UNTIL  OK; 

1772  15  26:0  161  tNO; 
1772  15  26:o  176 

177'+  15  27  :d      1  PROCEDURE  POPDOWIM; 

1775  15  27:D      1  {*  DISPLAYS  CONTEXT,  DOING  AN  IMPLIED  SCROLLUP  IF  NEC.  *) 

1776  15  27:0      0  BEGIN 

1777  15  27:i      0    IF  CLEARED  THEN  ERaSETOEOL ( X . LINE ) 

1778  15  27:i     11    ELSE  3EGIN  CLEARED : =TRUE ;  ERASEOS ( X» LINE )  END? 

1779  15  27:i     29    GOTOXY ( R JUST , LINE ) ; 

1780  15  27:i     38    ERASETOEOL ( R JUST i LINE ) ; 

1781  15  27:i     147    WRITE  (  CHR  (  LF  ))  ; 

1782  15  27:i     55    IF  LINE=SCREENHEIGHT  THEN  BEGIN  EXITPROMPT: =TRUE;  LINE :=SCREENHEIGHT-1  END? 

1783  15  27:i     72    WRITE( CONTEXT: EOLDIST ) ; 

178i+  15  27:i     87    FIRSTLINE  :=FALSE ;  (*  SAYS  THAT  THE  WHOLE  SCREEN  HAS  BEEN  AFFECTED.  ♦) 

1785  15  27:0     91  END; 

1786  15  27:0  104 

1787  15  2a:0      1  PROCEDURE  WRITESP ( CH:CHAR ; HOWMAMY: INTEGER ) ; 

1788  15  28:0      0  BEGIN 

1789  15  28:i      0    IF  X+HOWMANY<=SCREENWIDTH  THEN  WRITE< CH:H0WMANY ) ; 

1790  15  28:i     17    IF  X+H0WMANY>=SCREENWIDTH  THEN 

1791  15  28:2     26      BEGIN 

1792  15  28:3     26        GOTQXY  ( SCREEN^JlDTHt  LINE )  ; 

1793  15  28:3     33        IF  X  +  HOWiV|ANY>SCREENWlDTH  THEN 

1794  15  28:4     42  BEGIN  WRITECIM;  GOTOXY  ( SCREENWIDTH ,  LINE )  END 

1795  15  28:2     57      END; 

1796  15  28:i     57    X : =MIN ( SCREENWIDTH , X+HOWMANY ) 

1797  15  28:0     63  END; 

1798  15  28:a     84 

1799  15  29:d      1  PROCEDURE  CLEANSCREEn; 

1800  15  29:D      i  (*  CODE  TO.  IF  POSSIBLE,  ONLY  ERASE  THE  LINE,  OTHERWISE  CLEAR 

1801  15  29:D      1     THE  SCREEN,   THEN  CALL  POPDOWN  *) 
1302  15  29:o      0  BEGIN 

1803  15  29:i     3   firstline:=false; 

1804  15  29:1      4    IF  CLEARED  THEN 

1805  15  ?9:2      9      BEGI^J 


1307   l5    ^^-v     .^      -  ^^  X<SCRE£WWIDTH  THfTN  LRASEITOEOL  ( X ,  LINE ) 
xbu6   15    29:^     25    ELSE 
1809   15    29:2     27      SEGlM 


1810   15    ^915     27 


CLEAREO:=TRUE;  ERASEOS ( X t LINE ) 


1811  15  29:2  40  end; 

1812  15  29:i  inj          LINE:=LINE  +  1; 

lAif  ^-  ?^*^  ""^         ^'^    LINE>SCREENHEIGHT    THEN 

1814  15  29:2  55  3EGIM 

1815  15  29:3  55  LINE : =LINE-1 ; 

1816  lb  29:3  63  WRlTELN; 

WVu  W  IV^  ^^              exitprompt:=true 

1818  lb  29:2  69      END? 

\lll  \l  IIW  ^^    ^^  EOLDISTOO  THEN  POPDOWN 

1820  15  29:o  SO  END; 

1821  15  29:o  94 

1822  15  30:D  1  PROCEDURE  POPOV; 

1824  is  sS-n  \    **  T^^l    ^\"!;'-^'^^  ^O'^^'  ^^^^  PROCEDURE  IS  CALLED  WHEN  A  LINE  IS  OVERFLOWED 

1825  ll  30:'  \            NEXT^Jne"™  '•   THE  WORD  IS  SCANNED  OFF  AND  "POPPED"  DOWN  TO  THE^^^ 

1826  15  30:D  1  vAR 

\lll  \l  W.^r.  ^       wlength:  integer; 

\lll  .1  °  ^   save,ptr:  ptrtype; 

llll  ll  'Slo  0  bEG?n''  '*''''  '''''  CO..MAXSW.  OF  CHAR; 

\lll  \l  IV^  °    ^^  NOTEXTYET  THEN  FIXUP, 

1833  \l  IVA  ol         ^^'^  =  =^AX(SCAN(-MAXCHAR,  =  .-.,E3UF-CCURS0R-1D), 

1B34  \l  ll'A  ll         WLENGTH:=cSR'^iRl^\^^r''  =  '     '.  ESUF^CCURSOR-l .,)  .CURSOR ;      , 

1836  is  IIW  si         ^^BEGIN^"^''°    ^^    ^"^    ^'-^^^■^^>='^'^'^«SIN-LMARGIN    THEN 

^«^I  1^^  ^2*"  ^^      wr'itesp(ch,i); 

iflXQ  .1  f'''  ^2        EXiT(POPOV) 

1839  15  30:3  66  END; 

i?4?  Vi  ^ni?  ^"    ^"^  '^^='-'  THEN  WRlTE('-»); 

134^  1?  Inl^  ^^         G0T0XY(X-WLENGTH+1,LINE); 

llll  IS  in'..  ,^^    ^RASETO£OL(X.WLENGTHn,LlNt); 

i844  is  5n:i  ^°^    '^0^ERIghT(EBUF-CPTr:.EBUF-I:pTR  +  3J, WLENGTH); 

if45  is  ^n  i  Jo''    ^°V^»-EfT(EBUF-CPTR  +  3:], WORD, WLENGTH); 

iflu'  1=  ^  '^  ^^^    CURS0R:=CURS0R+3; 

1840  15  30:i  129    EBUF^C  PTR  3:  =CHR  ( EOL )  5                                                         S-^?' 


24S 


1840 

ia<+y 

1850 
1851 
1852 
1853 
1854 
1855 
1356 
1857 
1858 
1859 
1360 
1861 
1862 
1863 
1864 
1865 
1866 
1867 
1868 
1869 
1870 
1871 
1872 
1873 
1874 
1875 
1876 
1877 
1873 
1879 
1880 
1881 
1882 
1883 
1884 
1865 
1866 
1887 


15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 


30 
30 
30 
30, 
30: 
30 
30; 
30: 
30: 
30: 
30 
30 
30 
30 
30 
30: 
30: 
30: 
9; 
9; 
9: 
9: 
9; 
9; 
9; 
9: 
9: 
9; 
9: 
9: 
9: 

9 

9; 
9; 

9 

9: 
9: 
9: 
9; 
9: 
9; 


133 

13^3 

144 

144 

147 

150 

153 

153 

156 

158 

163 

171 

173 

177 

196 

204 

204 

220 

0 

0 

3 

15 

23 

28 

30 

33 

36 

113 

116 

123 

128 

131 

143 

148 

151 

156 

161 

161 

153 

lu3 

135 


EBUF'" 
WITH 
3EG 
S 

c 

G 
C 
END 
ELSE 

BLA 
EBUF'^ 
CLEAN 
X:=BL 
GOTOX 

x:=x+ 

NOTEX 
END  J 


i:pTr?+i::=CHR(DLE) ; 

PAG^ZERO  00  IF  AUTOlNOCNT 

i;'j 

ave:=cursor; 

ursor:=ptr; 

etleaoing; 

ursor:=save 


THEN 


(*  SET  BLANKS  TO  THE  INDENTATION  OF  THE  LINE  ABOVE  *) 


NKS:=LMARGIN; 
:pTR+23:=CHR(BLANKS+32) ; 

Screen; 

ANKS; 

Y(xtLiNE);  write(word:»^length)  ; 

wlength; 

tyet:=false 


begin  (*  insert  ♦) 
cleared:=false; 

EOLDISt:=SCAN(MAXCHAR.=CHR(EOL)  iEBUF'^CCURSORD)  ; 
MOVELEfT(EBUF^CCURsOKD,CONTEXTC0  3iEOLDIST) ; 

rjust:=screenwidth-eoldist; 

slamrIght; 

savebufcount:=bufcount; 

promptline:= 

•  INSERT:  TEXT  C<BS>  A  CHAR,<DEL>  A  LINED   C<ETX>  ACCEPTS,  <ESC>  ESCAPES:)' i 

PROMPT; 

exitprowpt:=false;  needprompt:=true; 
leftpart:=cursor-i; 
notextyet:=false; 
findxY(x»line) ;  gotoxy(X,line) ; 

ERASEToeOL(X,LINE) ; 

firstline:=true; 

if  EOLOISTOO  then  (*  A  CONTEXT  NEEDS  TO  BE  DISPLAYED  ♦) 
THEN  (♦  AND  IT  WILL  FIT  ON  THE  CURRENT  LINE 


•  •  • 


*) 


BEGIN 


IF  RJUST>X 
IN 
0T0XY(RJUST,LINE) ;  WRI T£ { CONTEXTIEOLDIST ) ;  GOTOXY (X, LINE ) 

AND  IT  WON'T  FIT  ON  THE  CURRENT  LINE  *) 


END 
ELSE  (♦ 
BE3IN 


186S 

15 

9:4 

135 

1889 

15 

9:4 

isa 

1390 

15 

9:4 

193 

1391 

15 

9:4 

199 

1892 

15 

9:5 

204 

1893 

15 

9:4 

212 

1894 

15 

9:3 

236 

1895 

15 

9:i 

236 

1896 

15 

9:2 

236 

1897 

15 

9:2 

238 

1898 

15 

9:3 

266 

1899 

15 

9:4 

266 

1900 

15 

9:5 

277 

1901 

15 

9:4 

311 

1902 

15 

9:5 

313 

1903 

15 

9:5 

320 

1904 

15 

9:6 

324 

1905 

15 

9:6 

357 

1906 

15 

9:4 

345 

1907 

15 

9:4 

360 

1908 

15 

9:4 

371 

1909 

15 

9:4 

374 

1910 

15 

9:5 

382 

1911 

15 

9:6 

382 

1912 

15 

9:6 

384 

1913 

15 

9:5 

389 

1914 

15 

9:3 

389 

1915 

15 

9:2 

389 

1916 

15 

9:3 

391 

1917 

15 

9:4 

391 

1918 

15 

9:5 

396 

1919 

15 

9:6 

396 

1920 

15 

9:6 

398 

1921 

15 

9:6 

401 

1922 

15 

9:5 

406 

1923 

15 

9:4 

406 

1924 

15 

9:5 

4C8 

1925 

15 

9:6 

415 

1926 

15 

9:7 

415 

1927 

15 

9:6 

420 

1928 

15 

9:9 

420 

firstline:=false;; 

ERASE0S(X,LINE) ; (*  CLEAR  THE  SCREEN  ♦) 
WRlTELPg; 

IF  LINE  =  SCREENHEIGHT  THEiM 

BEGIN  LINE:=SCREENHEIGHT-i;  EXI TPROWPT ; =TRUE  END; 

G0T0XY(RJUST,LINE  +  1);  k>/RI  TE  (  CONTEXT  :  EOLDIST )  ;  GOTOXY  (  X,  LINE) 

EN  J  5 

REPEAT 

INSERTCH; 

IF  NOT  (ORD(CH)  IN  CEQL , ETX. ESC ♦DEL.DCl J)  THEN 
BEGIN 

IF  TRANSLATECCH3=LEFT  THEN 

^JEGIN  IF  X<=SCREENWIDTH  THEN  WRITE ( CHR ( BSPCE) , »  • ,CHR ( BSPCE) ) J  X:=X-1  EN 

IF  CH=CHR(HT)  THEN  WRITESPC  •.SPACES) 
ELSE 

ELSE^^RUESP^CHan  '^^^  <  ^+1>=PAGEZER0.RMARGIN)  THEN  POPOV 

'%HEN  Wr1tE(CHR(BE^L)^^     (  X=SCREENWIDTH.8 )  AND  (CHOCHR(BS) ) 

IF  (EOLDISTOO)  AND 

(X>=RJUST)  AND  FIRSTLINE  THEN   (*RAN  INTO  CONTEXT  ♦) 
BEGIN 

POPDOWN; 

g0t0xy(x,line) 

end; 

END 

ELSE  {*  CH  IN  CE0L.ETXtESCtDEL»DC13  ♦) 
BEGIN 

IF  ch=chr(eol)  then 

BEGIN 

cleanscreen; 

X:=BLANKS; 
GOTOXY(X,HNE); 

END 
ELSE 

IF  ch=chr(del)  then 

BEGIN 

^''urrTM^''^  '^^^^       ^*    RIJSBED  OUT  ALL  OF  WHAT  WAS  ON  THE  SCREEN  ♦) 

3ufcount:=cursor+i;  24"^ 


230 


1929 

13 

9: 

19iO 

15 

9: 

1931 

15 

9: 

1932 

15 

9: 

1933 

15 

9: 

13i^ 

15 

9: 

1935 

15 

9: 

1936 

15 

9: 

1937 

15 

9: 

1938 

15 

9: 

1939 

15 

9: 

19fO 

15 

9: 

19'+1 

15 

9: 

19f2 

15 

9: 

1913 

15 

9: 

191f 

15 

9: 

1945 

15 

9: 

19'+6 

15 

9: 

1947 

15 

9: 

1948 

15 

9: 

1949 

15 

9: 

1950 

15 

9: 

1951 

15 

9: 

1952 

15 

9: 

1953 

lb 

9: 

1954 

15 

9: 

1955 

15 

3i: 

1956 

15 

31  ; 

1957 

15 

3i: 

1953 

15 

3i: 

1959 

15 

3i: 

1960 

15 

31: 

1961 

15 

3i: 

1962 

15 

3i: 

1963 

15 

3i: 

1964 

15 

32: 

1965 

15 

32: 

1966 

15 

32: 

1967 

15 

32: 

1968 

15 

32: 

1969 

15 

32: 

42o 

439 
445 
^54 
454 
456 
464 
474 
477 
486 
491 
491 
493 
498 
498 
508 
511 
511 
524 
536 
539 
541 
556 
556 
556 
1 
1 
1 
5 

f 
O 

8 

10 

14 

17 

1 

3 

3 

3 

4 

0 


EBUF^C CURSOR  J :=CHR{EOL) ; 
CEuTERCURSORCLINEfMIDDLE.TRUE) ; 
IF  EOLDISTOC  THEN  POPDOWN; 

IF  EXITPROMPT  THEN  BtSXN  PROMPT?  EXITPROMPT :=FALSE  END 
END 
ELSE 

BEGIN  [iOTOXYiO.LINE)  ;  CLEARED:=FALSE  5 

LRASETOEOL(0»LINE) ;  LINE:=LINE-1  END? 

getleading; 
x:=blanks-bytes+cursor-linestart; 

GOTOXY{X»LIi\lE) 

END 
ELSE 

IF  CH=CHR(DC1)  THEN 

BEGIN 

x:=0;  gotoxy(xfline) ;  erasetoeol(x,line) 

end; 
end; 
until  ch  in  cchr(etx) »chr(esc) :; 
if  ch=chr(esc)  then  cursor : =leftpart+1 ; 
bufcoUmt:=savebufcount; 

WRAPUP; 

end; 


(*$TM  0  V  E  I  T 


CURSOR  MOVEMENT,  PAGE.  ADJUST,  DELETE  *) 


PROCEDURE  MOVEIT; 
VAR 

scrollmark,x,line,i:  integer; 

EXITPROMPT:  boolean;  (*  PROMPT  AFTER  LEAVING  MOVEIT!  *) 

oldline,oldx:  integer; 
newoist.dist:  integer; 

doffscreen,atend,inreplace,indelete:  boolean; 
PTR, ANCHOR, oldcursor:  ptrtype; 


procedure  scrollup(3ottomline:ptrtype;  howmany: 

(*  BOTTO^ILINl  is  THE  "LINESTART"  OF  THE  LINE  TO 
VAR 

ptr:  ptrtype; 

i:  INTEGER; 

BEGIN 


INTEGER) ; 
BE  SCROLLED 


UP  *) 


1970 

1971 

1972 

1973 

197f 

1975 

1976 

1977 

1978 

1979 

1930 

1981 

1982 

1983 

198t 

1985 

1986 

1987 

1988 

1989 

199C 

1991 

1992 

1993 

199f 

1995 

1996 

1997 

1998 

1999 

2000 

2001 

2002 

2003 

2004 

2005 

2006 

2007 

2003 

2009 

2010 


I'D 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 
15 
15 
15 


32:  J 

i2:i 

32:i 
32:i 

32:2 
32:5 

32  :i 

32:2 

32:i 
32:i 
32:i 
52;?. 

32:2 
32:2 
32:2 
32:2 

32:i 
32:i 

32:o 
32:o 
33:d 
33:d 
3'+:d 
3'+:o 
3't:i 

3H:2 

3tf:3 
34:^1 
3'+:5 

34:5 

34:4 

34:3 
34:4 
34:5 
34:5 

5 

4 

3 

2 

1 


34 
34 
34 
34 
34 


G 

n 

6 

26 

62 

32 

52 

53 

59 

62 

67 

67 

72 

62 

90 

98 

106 

117 


(*  DISPLAY  ThL  'JEXT  LINE  ON  T4E:  nOTTOM  OF  THE  SCREEN  *) 


34:2 


ptr:=scaN(maxchar,=chr(eol),E3uf'^i:lineiptrd)+lii\ieiptr+i; 

WHILE     (KHOWMANY)    ANU    ( PTROUFCOUNT )    DO 

ciESiN' 

lpjeiptr:=ptr;   ptr:=scan{viaxchar,=chr<eol),ebuf-cptr3)+ptr+i; 

I  •  —  I  +  1 

end; 
i:=o; 
gotoxy(0»screenheight) ; 

REPEAT 
I:=I+i; 

BLANKS :=LEAD8LANKS(80TT0MLINE, BYTES) : 
WRlTt(CHR(LF))? 

LINEOUT OOTTOMLlNEt BYTES* BLANKS, SCREENHEIGHT)} 

LINE:=LINE-l; 

until  (i>=howniany)  or  ( b0tt0mline>=bufc0unt-1)  ! 
exitprompt:=true? 
121  end(*  scrollup  *) ; 

138 

1  procedure  CLEAR(X1,Y1,X2,Y2:  INTEGER);  FORWARD; 
5 

1  PROCEDURE  CENTER; 
0  BEGIN 

0   IF  indelete  then 

BEGIN 

IF  LINE>=SCREENHEIGHT  THEN 
BEGIN 

CENTERCURS0R(LINE,2,TRUE) ; 
asiV    ^^^^"^^^SOR-ANCHOR)  >  ABS(DIST)  THEN  CLEAR(  0  . 1  »MAX  (X-1 ,0  )  .LINE) 

ELSE 
BEGIN 

CENTERCURSOR t LINE, SCREENHEIGHT-1, TRUE); 
G0T0XY(X,LINE) ; 

IF  ABSCCURSOR-ANCHOR)  >  ABS(DIST)  THEN  WRITE(CHR ( 11 ) ) 

END ; 

doffscreen:=true; 

END 
ELSE 

IF  (CO«^MAND  =  PARAC)  AND  (  (  DIRECTION=  •  <  »  )  OR  (LINE  MOD  SCREENHEIGHT=OLDLINE ) ) 


5 
5 
12 
12 
20 
49 
51 
53 
53 
63 
72 
93 
93 
97 
97 
99 


251 


21^2 


<;011  15  6^:2  lib  THt.h    CLMERCURsORCLINtiOLDLIMEtTRUE) 

^012  16  5^:Z  1^5  FLSE    CrMTERCURsOK  ( LINE  t  VIIDOLE ,  TRUE )  ; 

2015  16  3^:1  mo  IF    EXlTPRO-'^PT    AND    ( COMMANDOtl'JI  TC )     THEN 

^014  15  5^:2  mg     begij 

2015  15  3f:3  l*+9        PROMPT;  EXITPRQMHT :  =FALSE 

2016  15  34:2  152      END! 

2017  15  3i^:i  156    OLDLlNr:=LINE;  OLDx:=X; 
2016  15  3^:0  163  END; 

2019  15  3mo  liiO 

2020  15  35:D      1  PROCEDURE  UPMOVE; 

2021  15  35:d    1  vAR  i:inteser; 

2022  15  35:0      0  BEGIN 

2023  15  35:i     0   i:=i; 

2024  15  35:i      3    GETLEADING; 

2025  15  35:i      6    (*  FIND  THE  LINE  FIRST  *) 

2026  15  35:i      6    WHILE  ( I<=REPEATFACTOR )  AND  (LINESTART>1)  DO 

2027  15  35:2     15      BEGlfJ 

2028  15  35:3     15        CURSOR :=LINESTaRT-1 ?  (*  LAST  CHAR  OF  LINE  ABOVE  *) 

2029  15  35:3     20        GEtlEADING; 

2030  15  35:3    23       LINE: =LINE-1 ;   i:=i+i; 

2031  15  35:2     36      END? 

2032  15  35:2     38    (*  IF  POSSIBLE  SET  THE  CURSOR  AT  THE  SAME  X  COORD  WE  CAME  FROM.   OTHERWISE, 

2033  15  35:2     38       SET  IT  EITHER  TO  THE  BEGINNING  OF  THE  BUFFER,  THE  BEGINNING  OF  TEXT 

2034  15  35:2     38       ON  THAT  LINE,  OR  THE  END  OF  THE  TEXT  ON  THAT  LINE  *) 

2035  15  35:i     38    CURSOR:= 

2036  15  35:i     38  N|AX{1,      (*  THE  BEGINNING  OF  THE  BUFFER  *) 

2037  15  35:i     39  MAX ( STUFFSTART ,   (*  THE  BEGINNING  OF  THE  TEXT  *) 

2038  15  35:i     10  MIN ( X-BLANKS+BYTES+LINESTART,  (*  SAME  COL  *) 

2039  15  35:i     1*9  SCAN  ( MAXCHAR ,  =CHR  ( EOL )  ,  EBUF*CCURS0R3 ) +CURSOR  (*  EOL  *) 

2040  15  35:i     59  ) 

2041  15  35:i  61  ) 

2042  15  35:i     66  ); 

2043  15  35:i  78    IF  LINEXl  THEN  CENTER; 

2044  15  35:0  87  END(*  UPALINE  *)! 

2045  15  35:o  102 

2046  15  36:D      1  PROCEDURE  OOWNMOVE; 

2047  15  36;D      1  vAR 

2043  15  36:D      1    l:  INTEGER; 

^049  li  36:D      2    NEXTEOi_:  PTRTYPE; 

2050  15  36:0      0  3EGIN 

2051  15  "^6:1      0    i:=l; 


2034       15  till  Is  '-■^^^Jj,';'"^^0L<3JFC0UNT-l)     AND    (  I<  =  REPEATFACT0R  )     DO 

20b5       15  35:3  ^d  CU.-JsOR '  =NEXTtOL  +  l ' 

ciODd       lb  36:i+  52  3i^GIfJ 

«i059       lo  36:5  52  "LlfJF  • -LI,Mt-^i  : 

2060       15  36:5  60  I-rf;!; 

20°62       is  nil  jI  IF^LINE  =  SCREENHEIGHT.1    THEN 

'ott     It  ^11  ;i  scrollmahk:=cursor; 

2065  15  36:^  78  EHO', 

2066  15  36:2  78  END; 

2068  ^^l  tt:].  ^°  ^^    LltME>SCREENHElGHT  THEN 

2069  15  36;3  lo'o  ^^^^;^^^^-SCREENHEieHT>  =  SCREENHEIGHT)  OR  (INDELETE)  THEN 

2070  15  36:2  100  ELSE 

2o'72   15  'til  III  3^^J^C^0LLUP(SCR0LLMARK,UINE-SCREENHEIGHT); 

20°7'   15  36;i  III  '*    SET'?r^?^HER'Tn'yHE'END°nc'I.J^„^J'^"^  ^  ^°°«°  «^  ""^  ^R0«.   OTHERWISE, 

2075  15  36:i  117  ON  tJaT  lInf  lo    Tur    rnn  nr  l^^    S^I^FER,  THE  BEGINNING  OF  TEXT 

2076  15  36: 1  117  cuR^nRl  «yM^on^;^nM^  l^^  ^'^°  °^  ^^^  ^^^^  °^  THAT  LINE  *) 

2077  15  36;i  120  ^^^^^OR ;  =MIN  (BUFCOUNT-1 ,       (*  END  OF  THE  BUFFER  *) 

2078  15  36:i  121  '  Sl^^'^^'^f '^^'     ^*  ^^°T  ^^  ^^E  INDENTATION  ♦) 

2079  15  36:i  123  WIN { X-BLANKS+BYTES+LINESTART  (*  WHERE  IT  WANTS  TO  BE  *) 

2080  15  3o:i  140  ;SCAN(MAXCHAR,=CHR<E0L).E3UF-CCURS0RD)+CURS0R 

2081  15  36:i  142  , 
2032   15  36:i  147  ,. 

Intt      ^l  it'"^  ^^^  ^'^°<*  DOWNMOVE  *); 

2084   15  36:0  174 

fofi!  II  11:^  '    PROCEDURE  leftmove; 

2086   lb  37:o  0  BEGIN 

2ofI  II  37M  l  tu^^l'^^^^.V     ^*  ^^^  LINESTART  AND  STUFFSTART  *) 

2089   15  37;2  14  '^^^|j  :^5TUFFSTART>cURS0R-REPEATFACT0R )  AND  ( CURSOR>REPEATFACTOR )  DO 

20%'i°  II  ^\l  II  IfTalf'cZ^^^^                                                                                              (*  CHARS  MOVED  OVER  *, 

2092   15  37'^  7=  :;,  "^-""^  LLUKb0R3-CHR(E0L)  THEN  CURSOR :  =CURS0R-1 ; 

•'  '"  ^^^sor:=,max(scan(-maxchar,=chr(eol),ebuf-ccurs5r:).cursor,i);        -.r-o 

Iw  vj  J 
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38:3 

68 

2115 

15 
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38:2 

104 

2120 

15 

38:3 

108 

2121 

15 

3a:i 

118 

2122 

15 

38  :i 

131 

2123 

15 

38  :o 
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LlME:=LINE-li 

GETLEADING:     (*    RESET    LlrjESTART    AND    STUFFSTART    *) 

end; 

CURS0R:=MAX(3TUFFSTArtT,MAX(CU'^S0K-REPEATFACT0R,l)  )  ; 
IF    LII\lr<l    THEN    CENTER; 
FINDXY(X.LINE)  ; 

END  (*  left^ove  *) ; 

PROCEDURE  RIGHTMOVE; 
VAR 

EOLPTR:  ptrtype; 

BEGIN 

EOLPTR : =SC AN (MAXCHAR»=CHR(E0L),E3UF*C CURSOR  3 )+CURS0R; 

WHILE  (E0LPTR<CUR30R+REPEATFACT0R)  AND  { E0LPTR<BUFC0UNT-1 )  DO 

BEGIN 

repeatfactor:=repeatfactor-(eolptr-cursor+i) ; 

cursor:=eolptr+i;  (*  beginning  of  the  line  below  *) 

getleaoingj 

cursor:=stuffstart; 

line:=line+i; 

if  line=screenheight+i  then  scrollmark:=linestarT; 

eolptr:=scan(maxchar»=chr(eol)febuf*ccursora)+cursor 
end; 
IF  line>screenheight  then 
IF  (line-screenheight>=screenheight)  OR  (indelete)  then 

center 

ELSE 

SCR0LLJP(SCR0LLMARK,LINE-SCREENHEIGHT) ; 
CURSOR :=^IN(BUFC0UNT-1»CURS0R+REPEATFACT0R) ; 

findxy(x»line) ; 
end(*  rightmove  *) ; 

PROCEDURE  LINEMO\/E(REPEATFACToR:  INTEGER); 

VAR  i:   Integer; 

cjEGiN 

i:=i; 

IF  oiREcTioN=»<'   Then 

BEGI"^| 

WHILE  (I<=REPEATFACT0R)  AND  (CURS0R>1)  DO 
3EGIN 

IF  EBUF''CCURSORJ=CHf  -QL)  THEN  CURSOR  :=CURS0R-1 ;  (*  NULL  LINE    ^^E  *) 


^136  15  ^9.*a      ,                                ^^    CUKS0R>  =  1  THEf.  BEGIN  LINE :  =LINE-1 ;  i;  =  I  +  l  END; 

^isl  in  ^9-^     ^^        CU^S0R:=MAX(1, CURSOR);  (*  BACK  INTO  REALITY  *) 

:;:q  ]^  tl'^         ''      atend:=  (cursor=i); 

oiun  -?  f!*^     "''^        ^^    LlfML<l  THEN  CENTER 

ai'+rj  lb  39:2     Bo      END 

^Itl  15  39:i     8d    ELSE 

?lu?  Jr  ^r^     ^^      ^^'^^'^  **  DIRECTI0N='>'  *) 

tlli  15  39:4    101        WHiLE^(I<=REPEATFACTOR)  AND  ( CURS0R<BUFC0UnT-1)  DO 

nil  II  ^\l         ll'y                        ''??cSr1o1<b%'f^^^^^                                       (*XD0WN*, 

i^ll  II  J^'^  ^22              BEGIN 

tilt  ^t  IV^  ^^^                             ^•  =  1^1'  line:=line+i! 

2150  15  39;!  1H3               .^^    UINE=SCREENHEIGHT+1  THEN  SCROLLMARK: rCURSOR ; 

2151  15  39.*^  l<+3          END;^^° 

^.ll  ^l  !!*2  150        ATenD:=  (CURS0R>=BUFC0UNT-1); 

t^iu  1R  tl'^  ^^®        ^^  LINE>SCREENHEIGHT  THEN 

2155  IS  IV'l  Itl                 ^^   <line-screenheight>=screenheight)  or 

2156  IS  tl'-l  .1.                                 INREPLACE    OR    ( CON!MAND=PARAC )    OR    INDELETE 
<:xob  10  ^9. It  180                             THEN 

2157  15  39:5  186                              CENTER 

2158  15  39;4  166          ^LSE 

216T  fs  IV'l  lln                              SCR0LLUP(SCR0LLMARK,LINE-SCREENHEIGHT)! 

^7^,  ^^  t   '^  200      cursor:=min(Cursor,3Ufcount-i) 

2161  15  39:2  20^      end; 

2162  15  39:i  211    GETLEAdING; 

2^"  II  IVA  IIj      x:=blanksI'"'''^''''"''  '"■  ''°''''^°  "^°  beginning  of  stuff  *) 

2165  15  39:0  221  END(*  LiNEMOVE  ♦); 

2166  15  39:0  238 

2167  15  40:0      1  PROCEDURE  JUMPBEGIN; 

2168  15  40:0      0  BEGIN 

fl7n  Is  aSii               °         CURSOR:=l;    CENTERCURS0R(TKASH,1, FALSE) 

dlfO  15  'toio            8   emd; 

2171  15  4+0:0            2'+ 

2172  15  m:D               1    PROCEDURE    JUiMPEND; 

2173  15  m:o      0  BEGIN 

217^  15  4i:i      0    CURS0R:=3UFC0UNT-l;  CENTERCURSOR ( TRASH, SCREENHEIGHT , FALSE )                  "^^^ 


217b  15  m:a         ig  ^nd; 

2176  15  41:g            <?b 

2177  lb  <+2:D               1    PROCEOURl    ADJUSTING; 
cl73  15  42:D               1    LABEL    i; 

i:179  15  i+ZID                1    TYPE 

2180  15  42:o              1         ■«IODES=(RELATIVLtLEFTvJ.RIGHTj,CEr>iTER)  ; 

2131  15  42:D               1    VAR 

2182  15  'f2:D      1    LLENGTH,TDELTA,l:  INTEGER; 

2183  15  112:0          4       savedir:   char; 

2184-  15  42:0             5        [>^ode:    ^odes; 

2165  15  42:0              6 

2186  15  H3:D      1  PROCEDURE  DOIT (DELTA: INTEGER ) i 

2187  15  43:0      2  VAK 

2188  15  4310      2    EOLDISt:  INTEGER? 

2189  15  '+3:D      3    T:  packed  ARRAY  C  0 .  .MAXSTRING3  OF  CHAR; 

2190  15  H3:0      0  bEGIN 

2191  15  f3:i      0    GETLEADING;  (*  SET  LINESTART.  STUFFSTART.  AND  BLANKS  *) 

2192  15  ^l\\               3    IF  BLArgKS  +  DELTA<0  THtN  DELTa:  =-BLANKS ; 

2193  15  *+3:i    m   IF  {eb[jf"c:linestart3=chr(dle))  and  (Stuffstart-linestart=2)  then 

2191+  15  ^3:2     27      X  :=OrD  ( EBUF'^CLlNESTART  +  1 3) +DELTA-32 

2195  15  43:1     34    ELSE 

2196  15  13:2           41              BEGIN 

2197  15  i+SrS            41                    IF    STUFFSTART-LINESTART>2    THEN 

2193  15  43:4            48                         MQVELEFT  { EBUF'^tSTUFFSTARTDt  EBUF'*[:LINESTART+2D.BUFC0UNT-STUFFSTART  ) 

2199  15  43:3            59                   ELSE 

2200  15  43:4     61          BEGIN 

2201  15  43:5     61            IF  BUFCOU^JT>tiUFSlZE-100  THEN 

2202  15  43:6     68              BEGIN 

2203  15  43:7     68                ERROR( 'BUFFER  OVERFLOW • .NONFATAL) J 

2204  15  43:7     90                 EXIT < ADJUSTING ) 

2205  15  43:6     94              END 

2206  15  43:5     94            ELSE 

2207  15  43:6     96              MOVERIGHT  ( EBUF'C  STUFFSTART  3 .  EBUF'"CLINESTART  +  23.BUFC0UNT-STUFFSTART )  ; 
2206  15  43:4  107          rfgD; 

2209  15  43:3  107        IF  LlNESTART+2<>STUFFSTART  THEN 

2210  15  43:4  114          3EGIN 

2211  15  43:5  114            READJUST ( LINESTART » LINESTART+2-STUFFSTART ) ; 

2212  15  43:5  123            5UFC0UNT : =BUFCOUNT+Ll NESTART+2-STUFFSTART ; 

2213  15  43:4  132          END; 

2214  15  43:3  152        EBUF^C LINESTART 3 : =CHR ( OLE ) ; 

2215  15  >3:3  156        X : sBLANKS+DELTA ; 


mode:=relative; 
showcursor; 
findxy(x,line)  ; 


2216  15  <45:2  m?.  Ei.d; 

?^II  ^^  a?'^  ^''^  E:SJF-ClIWESTAHT+U:=CHR(X+32); 

^219  1^  u^'J  P^  CURS0R:=Ll:jESTART  +  2;     GETLLADIMG ; 

2220  15  li'l  lyl  f  SJj.^^J^V  ^' t^'^^  "     ^'^''^^^°^°'- <  ^  '  ^^'^^^  »'<*    £^«^SE    THE    LINE    *  ) 

222S  II  lUl  i,'^  .,^^°^J!^ii'^^■^^«^'BYTES, BLANKS, LINE);     GOTUXY(X, LINE); 

2222  15  43; 0  206  " 

00??  J^  ''^•^  ^'  -^^^'^    <*    ADJUSTING    ♦) 

'225  I5'  :L:^  °  ^ITHJAGEZERODO 

1227  I5  .'213  iS  INREpJaCE?-?rSe-"''    ^^^^^«°^^^^  =^ALSE  ;     INDELETE:=FALSE ;    LASTPAT:=CURS0R  , 

2229  ]l  IV'^  ^^  pRo,mptline:  = 

2231  k  :ii5  £  '    ''S^T^^;;^?Jp^i;i:;?I  =  ?^S^!^«    <LEPT,RISHT,UP,D0.N.ARR0WS>    C<ETX>    to    leave.. 

2232  15  f2:3  m 

2233  15  1+2:3  im 

2235  15  42:3  126  REPEAT 

2237  J^  IV^  ^^^  ch:=getch; 

223fl  IS  loll  If^  command:=maptocommand{ch); 

tilt  ^l  al:^  ^^  infinity:=false; 

22^n  7r  lo'.l  il^  ^^    COMMAND=SLASHC  THEN 

d^^O  15  t2:5  150  BEGIN 

22^12  is  lilt  I7I  Repeatfactor:=i;  INFINITY:  =true ;  ch:=getch;  command:=translatecchd 

2243  15  42:4  173  elSE 

2245  is  42-a  ]ll  ^^  COMMAND=DlGIT  THEN  REPEATFACTOR : =GETNUM  ELSE  REPEATFACTOR '"l 5 

2246  IS  IZ'-t  IJ  ^^    COMMAND  IN  CUP,DOWND  THEN  "Lf'l.A  1 FACTOK  .-1 . 
ccTo  i3  '+^.b  204  BEGIN 

224I  is  nil  2?7  IF_COMMAND=UP  THEN  DIRECTION: =•< •  ELSE  DIRECTION:=.>. ; 

2249  15  42:6  220  ATEND • =FflL SF • 

2250  15  UP'f;  ooii  Ml  t-NU.-FAL^Li 

2251  15  42:7  238  "^urrT^^  ^"^^^^  '^"^  '  «  I<=REPEATFACT0R  )  OR  INFINITY)  DO 

2252  15  42:8  233  I-=I+i; 
2I54  II  11:1  1:1  LIN^JJVECI); 
2255  is'  ll\l  lit  '' ^1%''^^'^    '^^'^ 

"^  "^^  IF  MODE  =  RELATIVE  THEN  DOIT(TDELTA)                       ^^^ 
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15 
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15 
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15 
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15 
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15 
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15 

42:5 

340 

2272 

15 
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15 
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15 
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15 
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15 
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15 
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2278 

15 
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15 
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15 

42:6 
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15 
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15 
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2283 

15 

42:9 

385 

2284 

15 

42:9 

383 

2285 

15 

42:9 
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2286 

15 

42:o 
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2287 

15 

42:9 

415 

2288 

15 

42:o 
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2289 

15 

42:i 

422 

2290 

15 

42:o 

436 

2291 

15 

42:i 

438 

2292 

15 

42:2 

438 

2293 

15 

42:2 

441 

2294 

15 

42:i 

460 

2295 

15 

42:8 

462 

2296 

15 

42:7 

462 

2297 

15 

•12:  a 

464 

ELSE 
bE-GIN 

LLtrJGTH:=SCArJ(MAXCHAR,=CHR(EOL)  ,  EBUF'^i:  STUFFSTART  J  )  ; 

case  mooe  of 
leftj:     doiklmargin-blanks)  ? 
rightj:  doit( (rmargin-llength+d-blanks) ; 

cfnter  * 

doit{({rmargin-lmargin+i)-llength)  div  2-blanks+lmargin; 

END  (♦  case  *) 
END  (*  ELSE  *) 
end;  <*  IF  NOT  ATEND  *) 
END  (*  WHILE  ...  *) 

END 
ELSE 

if  cqmmand=left  then 
^^doit(-repeatfactor) ;  tdelta:=tdelta-repeatfactoR5  mode:=relative 

END 
ELSE 

IF  command=right  then 
^^doit(REPeatfactor) ;  tdelta:=tdelta+repeatfactor;  mode:=relative 

END 

ELSE 

IF  command  in  CLiSTC.REPLACECtCOPYCD  THEN 

BEGIN 

getleading; 

LLEMGTH:=SCAN(MAXCHARi=CHR(EOL) »EBUF"CSTUFFSTART3) ! 

IF  C0MMAND=LISTC  THEN 

BEGIN  M0DE:=LEFTJ;  DOIT(LMARGIN-BLANKS)  END 

ELSE 

IF  command=replacec  then 
BEGIN  mode:=rightj;  doit((rmargin-llength+1)-blanks)  end 

ELSE    (♦    COW'^ANDsCOPYC    *) 
BEGIN 

DOlTiuRMARGIN-LMARGIN  +  D-LLENGTH)    DIV    2-BLANKS  +  LMAR6IN ) 

END 
END 

IF  CH<>CHR(ETX)  T^   "  BEGIN  ERRWAIT;  SHOWCURSOR  END; 


oil       ^l  "^'^  '^^^                    -•    ^^■^■■Ti'-    CH  =  CHK{ErX): 

^29^       lb  H2:5  '484                     Dl.:<LCTiON:=SA\/rDIR; 

^^Oa       15  ^+2:2  1:17                tN,i; 

2301  15  42:u  487    END; 

2302  15  '+2:0  bu6 

2303  15  'fiftD               1    PROCEDURE    TA33Y! 

230°5       II  l^\l               \    ;:,'''"    '^'"^    ^^^    ^^^^    ^^"^    Y°^    ^I^HER    HIT    A    TA8ST0P    OR    THE    END    OF    THE    LINE    *) 

lln^       ii  '^?''^'               ^          NEWX,ErgDX,I,NUiVlTOGo:     INTEGER; 

2307  15  (+1:0      0  3EGIN 

2308  15  44:1  0  NUMTODO:=REPEATFACTOR; 
^^OJ  lb  44:1  3  FOR  i:=i  TO  NUMTODO  00 
ii3lO  15  44:2     14    BEGIN 

2311  15  44:3    14    repeatfactor:=i; 

23^3  II  nil  II              ;Lx'-xr'°'^''*  '"'"  RIGHT^OVE  ELSE  LEFTMOVe; 

il^t  J-!  ''''•^  22    with'pagezero  do 

2315  15  44:4  33        BEGIN 

f::^  J^  '^'*'^  33       IF  direction=«>«  then 

2317  15  44:6  38            BEGIN 

2319  15  44.*7  it                        e:ndx:=scan(maxchar,=chr{eol),ebuf-ccursord)+x; 

2320  15  llll  ?7            ENd"^^^  ( TaBSTOPCNEWXD=NONE)  AND  (NEWX<ENDX)  DO  NEWX:=NEWX+1 ; 

2321  15  44:5  77          riSE 

2322  15  44:6  79            BEGIN 

I324  15  lai^  ^^          getleading; 

2325  15  44;!  105            END^^*"^  { TA3ST0PCNEWX  ]  =  NONE )  AND  (  NEWX>BLANKS)  DO  NEWX:=NEWX-1 ; 

?lly  ^l  till  ^°^          REPEATFACT0R:=ABS(NEWX-X); 

232I  II  ll:l  III                    ,,J^  ?rw5T"*r"  ™'  RISHTMOVE  ELSE  LEFTMOVE, 

2329  15  44:2  124    END  (*  FOR  *) 

2330  15  44:0  124  ^md; 

2331  15  4^:0  150 

2332  15  45:d      1  PROCEDURE  MOVING; 

2333  15  45:d      1  vAR 

2334  15  45:D      1    SAVEX:  INTEGER; 

2335  15  45:0      0  BEGIN 

2336  15  45:1    0   indelete:=false; 

mi  }i  "^-^    '+   inreplace:=false; 

2338  15  45:1               9         EXITPR0MPT:=FALSE;                                                                                                                                                         P39 
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45:3 

171 

2363 

15 

45:2 

183 

2364 

15 

45:2 

183 

2365 

15 

45:2 

230 

2366 

15 

45:3 

239 

2367 

15 

45:2 

248 

2368 

15 

45:3 

250 

2369 

15 

45:4 

259 

2370 

15 

45:5 

259 

2371 

15 

45:6 

295 

2372 

15 

45:4 

306 

2373 

15 

45:3 

306 

2374 

15 

45:4 

308 

2375 

15 

45:5 

317 

2376 

15 

45:6 

317 

2377 

15 

45:6 

336 

2373 

15 

45:7 

350 

2379 

15 

■^5:5 

364 

IF  DIRECTION=»<»  THEN  JUMPBEGIN  ELSE  JUMPEND 


LEFTMOVE  ELSE  RIGHTMOVE; 


IF    irjFiNlTY    THEIlM 
BLGliJ 

CASE.    COMMAND    OF 

uptLEFT:  jumpbegin; 

DQu^N,  right:  JUMPEND; 

oARACt SPACE, AC VANCE, Tab: 
END; 

MEEDPRO'^PT:  =  TRUEi 
NEXTCO^MANOS 
EXIT(MOVEIT) 

end; 
findxy(x.line) ; 

REPEAT 

olox:=x;  oldline:=line; 
case  command  of 

left:  LEFTMOVE; 

right:  rightmove; 

space:  if  direction='<'  then 

up:  upmovei 

do^jn:  downi^ove; 

advance:  LINEM0VE{REPEATFACT0R) ; 

parac : 

IF    REPEATFACTOR>1000    then    ERRORCTOO    MANY'tNGNFATAL) 
ELSE    LINEM0\/E(SCREENHEIGHT*REPEATFACT0R)  5 

tA'b:  tabby 
end; 
if  exitprompt  or  ( c0mmand=parac )  then 

gotoxy(x,line) 

ELSE 

IF  LlNE=OLDLINE  THEN 
BEGIN 

IF  X=0LDX+1  THEN  CONTROL(FS)  ELSE  IF  X=0LDX-1  THEN 
ELSE  GOTOXY(X,LINE) 
END 
ELSE 

IF  X=OLDX  THEN 
BEGIN 

IF  LINE=0LDLINE+1  THEN 
ELSE  IF  LINE=0LDLINE-1 
ELSE  G0TGXY(X,LINE) ; 
ENJ 


WRITE{CHR(BSPCE)) 


niRlTE(CHR(LF)  ) 
THEN  CONTROL(US) 


2380 

15 

45:^+ 

364 

^J3l 

15 

^+5:5 

iao 

2382 

lb 

45:2 

375 

2335 

15 

45;2 

373 

238^ 

lo 

45:i 

378 

2383 

lb 

45:i 

536 

2386 

15 

45:i 

401 

2387 

15 

45:  0 

404 

2383 

15 

45:o 

418 

2385 

15 

46:d 

1 

2390 

15 

46:d 

3 

2391 

15 

46:o 

3 

2392 

15 

46  :d 

4 

2393 

15 

46:o 

0 

253^ 

15 

46  :i 

0 

2395 

15 

46:i 

3 

2396 

15 

46:2 

8 

2397 

15 

46:3 

8 

2398 

15 

46:4 

15 

2399 

15 

46:5 

15 

2^00 

15 

46:5 

26 

2401 

15 

46:5 

36 

2402 

15 

46:6 

45 

2403 

15 

46:5 

53 

2404 

15 

46:4 

54 

2405 

15 

46:3 

58 

240& 

15 

46:4 

60 

2407 

15 

46:2 

75 

2408 

15 

46:o 

77 

2409 

15 

46:o 

92 

2410 

15 

33  :d 

1 

2411 

15 

33:o 

5 

2412 

15 

33:d 

5 

2413 

15 

33  :o 

5 

2414 

13 

33:d 

5  \ 

2415 

15 

33:o 

0  ; 

2416 

15 

33  :i 

0 

2417 

15 

33:i 

5 

2418 

15 

33:i 

8 

2419 

15 

33:i 

47 

2420 

15 

33:i 

71 

GOTOXYCXtLIisit)  ; 

repeatfactor:=i; 

mlxtco^mand 

UNTIL  .JOT  (COMMAND  IN  C  UP  ,  DO^^N  ,  LEFT  ,  RIGHT  ,  ADVANCE  .SPACE  ,  TABU  )  • 
IF  EXITPROMPT  THEN  PROMPT;  "uvHwucb^ALL  .  T  AB  J)  , 

SHOWCURSOR; 

END  (*  WovING  *) ; 

PROCEDURE  PUTITBACK(C1.C2:  PTrTYPE); 
VAR 

ptr:  ptrtype; 

INDENT, lOFF:  INTEGER? 
BEGIN 

ptr:=ci; 

i^HlLE    PTR<=C2    DO 
BEGIN 

IF    EBUF''CPTR3=CHR(E0L)    THEN 
BEGIN 

ptr:=ptr+i;  writeln; 
inoent:=leadblanks(ptr,loff) ; 

IF  (PTR<C2)  and  (INDENT>0)  THEN 
WRITEC  »:INDENT); 

ptr:=ptr+loff 

END 
ELSE 

^BEGiN  write(ebuf«i:ptR3);  ptr:=ptr+i  end; 

END  5 

end; 

PROCEDURE  CLEAR(*X1,Y1»X2,Y2:  INTEGER*); 

(*  SCREEN  CO-ORDINATE  (XI, YD  IS  ASSUMED  TO  BE  BEFORE  (X2,Y2)    THIS 

vAR  XX. I:  integer; 

3EGIN 

GOTOXY(Xl.Yl) ; 

XX : =xi • 

ELSE  For  i:=xi  to  x2  do  writec  m  2Gt 
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15 
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15 
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15 
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15 
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15 
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15 
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15 
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15 
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2435 

15 

47: 

2436 

15 

47: 
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15 

47: 

2438 

15 

47: 

2439 

15 

47: 

2440 

15 

47: 

2441 

15 

47: 

2442 

15 

47: 

2443 

15 

47: 

2444 

15 

47: 

2445 

15 

47: 

2446 

15 

47: 

2447 

15 

47: 

2448 

15 

47: 

2449 

15 

47: 

2450 

15 

47: 

2451 

15 

47: 

2452 

15 

47: 

2453 

15 

48: 

2454 

15 

48: 

2455 

15 

48: 

2456 

15 

48: 

2457 

15 

48: 

2458 

15 

48: 

2459 

15 

48: 

2460 

15 

48: 

2461 

15 

■is: 

33 

124 

1 

1 

i_ 

6 

0 

0 

10 

20 

29 

44 

46 

55 

70 

72 

76 

89 

89 

98 

107 

113 

116 

127 

131 

135 

135 

140 

142 

144 

153 

166 

1 

1 

1 

1 

4 

7 

d 

0 
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PROCEDURE  resolve:scree;n; 

VAR 

Xl,X2.Ylf Y2»SAVE:  INTEGER; 
CltC2:  PTRTYPE; 

BEGirJ 

xi:=x;    yi:=LiNE; 

X2:=0LDX;  Y2:=0LDLINE; 
IF  NEWDIST>DIST  THEN 

BEGiivi  ci:=cuRSOR-i;  c2:=oldcursor;  xi:=xi-i  end 

ELSE 

if  newoiskoist  then 
begim  c2:=oldcursor-i;  ci:=cursor;  x2:=x2-i  end 

ELSE 

EXiT(RESOLVESCREEN) ; 
IF  (Y1>Y2)  OR  {(Y1=Y2)  AND  (X1>X2))  THEN 
BEGIN 

save:=ci; 
save:=yi; 
save:=xi; 

end; 
if  abs(newdist)>abs(dist)  then 

CLEAR(X1iY1.X2iY2) 

ELSE 

BEGIN 

gotoxy(Xi,yi) ; 

PUTITBACK(C1»C2) 

end; 

GOTOXY(XtLINE) 

end; 

procedure  deleting; 

LABEL  i; 
VAR 

atbol»anchor,sa\/e:  ptrtype; 
ok,atbot»nomove:  boolean; 
startline:  integer; 

BEGIN 

doffscreen:=false;  indelete; 


ci:=C2;  C2:=save; 
yi:=Y2;  Y2:=sa\/e; 
xi:=x2;  X2:=SAVE 


•rue;  inreplace:=false;  exitprompt:=false 


nil     W       lV-\  it   Ar.CHaR:=cURS0H;  r.iEwDlST:=o; 

^a-I   ,^^    ^^^^    ^^^    SHOWCURsOR; 
2^b3   15    ^8:i    116    FINDxy(XtLlN£)- 


2^+69       15         H8:i         125 


STAKTLir\!E:=LINE; 


2'+70  l3  ^8:i  130  REPEAT 

IVjI  \l  !!!*^  ^^°  3ldcursor:=cursor; 

llll  1  aa'f  '^'^  dist:=newdist; 

llil  15  Je.p  ISP  ^°'--''   oldline:=line; 

<=■■»'•+  ID  Ha, 2  152  CH:=GETCri; 

2^176  \l  uA.'o  \ll  command:=translatecch3; 

2477  15  ll'-l  i«!  II    ^3M"AND=DIGIT    THEN    REPEATFACT0R:=GETNUM    ELSE    REPEATFACTOR'-I  • 

2^78  is  ^8:1  ill  %EGir°    '"    '^R^V^RSEC. . DIGIT, ADVANCE. SPACED    THEN                            •■'' 

nil  il  IV'u  III  '-^^^-   leftmove; 

2^82  \l  ll'l  Pn7  ''^^^=    RIGHTMOVEJ 

2'*83  Is  im  III  Up''uPMOW.°'""''°'=*'*    '"""  '■^'^^"°^^  ^^s^  RIghtmove; 

'.Is  is'  :!::  Ill  PoiNfSS^UvE; 

2'+86  15  48*4  HI  ADVANCE:    LJNLMOVE  ( REPEATFACTOR)  ; 

2'f87  is  ll^'l  III  REVERSEC.FORWARDC: 

2488  is  UA  2^*^^'^ 

2489  15  48-7  III  ^^    COMMAND=REVERSEC  THEN 

2490  is  46:1  III  DIRECTI0N:=.<. 

2:^2  is  IV^'  III  d?rection:  =  om 

2493  15  4815  268  tmh^^^^^^ ° ' ° * '  WRITE( DIRECTION) ;  GOTOXY ( X.LINE) 

mi  \l  11:1  ''°  tab:  TABBY 

2495  15  '+8:4  270  eND; 

nil  is  IV'l  ^?n  newdist:=cursor-anchor; 

mi  \l  IV^.  Ill  ^^^^solvescreen; 

2499  15  48:2  312  ELSE 

25??  is  IV'l  Ml  ^^    (CH<>CHR(ESC))  and  (  CHOCHR  (  ETX)  )  THEN 

2502  il  ll'-l  lil         ,„.,,   3EGIN  ERRWAIt;  GOTOXY  ( X  .LINE)  END                                   opo 

ID  '+8.1  339    UNTIL  (CH  IN  C  CHR  ( ETX )  ,  CHR  ( ESC )  D )  ;                                          2G3 


p 


04 


<:503  15  18:i  352  IF  CH  =  CHR(tTX)  THZiJ 

aDOt^  15  13:2  359  dtlSlAi 

2505  15  <+8:3  359  GETLEAOING  ;  (*  INDENTATlOi\J  FIXUP  *) 

2506  15  ^8:3  3b2  IF  aTBOT  ANO  ( CUKS0R=STUFFSTART )  THEN 

2507  15  48:4  369  BEGIN  CURSOR : =LINESTART ;  SAVE! =ANCHOR ;  ANCHOR : =ATBOL  END! 

2508  15  i+arS  378  IF  OKTODEL  ( CURSQK « ANCHOR )  THEN 

2509  15  '^am-  3b7  BEGIN 

2510  15  'ISIS  387  READJUST  ( MIN(  CURSOR  f  ANCHOR  )♦ -ABS  (CURSOR-ANCHOR ))  ; 

2511  15  f+SIS  402  C0PYLINE:  =  (CURS0R=LINESTART)  AND  ATBOT; 

2512  15  1+8:5  <\10  IF  ANCHOR<CURSOR  THEN 

2513  15  '+8:6  415  MOVELEFT  ( EdUF'^CCURSOR  3, EBUF'^C  ANCHOR  D«BUFCOUNT-CURSOR ) 

2514  15  48:5  424  ELSE 

2515  15  48:6  426  MOVELEFT  ( EBUF'^C  ANCHOR  3,  EBUF'"CCURS0R3,BUFC0UNT-ANCH0R )  ; 

2516  15  48:5  435  BUFCOUNT: =BUFCOUNT-ABS(CURSOR-ANCHOR ) ! 

2517  15  48:5  443  CURSOR:=MIN ( CURSOR t ANCHOR) ! 

2518  15  48:5  452  GETLEADING;  CURSOR :=MAX ( STUFFSTART,CURSOR) 

2519  15  48:4  457  END 

2520  15  48:3  464  ELSE 

2521  15  48:4  466  CURS0R:=SAVE 

2522  15  48:2  466  END 

2523  15  48:i  469  ELSE 

2524  15  48:2  471  BEGIN 

2525  15  48:3  471  C0PYLINE:=FALSE ;  COPYOK : =TRUE? 

2526  15  48:3  479  COPYSTART: =MlN(CURSORt ANCHOR )  ; 

2527  15  48:3  469  COPYLENGTH : =A3S(CURS0R-ANCH0R ) ; 

2528  15  48:3  496  CURSOR: =ANCHOR ; 

2529  15  48:2  499  END? 

2530  15  48:i  499  1 : INDElETE : =FALSE ; 

2531  15  48:i  503  OK: =(LINE=STARTLINE )  AND  NOT  DOFFSCREEN; 

2532  15  48:i  515  UPSCREEN ( OK ,NOT  OK, LINE); 

2533  15  48:i  524  NEXTCO^ilMAND ; 

2534  15  48:0  526  END; 

2535  15  48:o  540 

2536  15  3i:o  0  BEGIN 

2537  15  3i:i  0  IF  COMiViaND=DELETEC  THEN 

2538  15  3i:2  5  DELETING 

2539  15  3i:i  5  ELSE 

2540  15  3i:2  9  IF  C0MMAND=AD JUSTC  THEN 

2541  15  31:3  14  SESIN  ADJUSTING?  NEXTCOMMANO  END 

2542  15  3i:2  18  ELSE  MOVING! 

2543  15  -^IIO  22  END! 


2b^'4  15  31:  J     34 

2545  lb  3l:,j     ^L^ 

IT^7  II  l\ll            i:  '-"'    '    "  0    ^    «  E  P  L  A  C  E., 

2550  15  &:z               1  vAR 

2552  15  flin      I         JLREADYSAIOGO, THERE, FOUND, LASTPATTERN:  BOOLEAN; 

2553  II  Ifo  11   ,'e5?';tr:'p?r;yp^^^^^                    ^^^"^«' 

?s^K  Jc  ='°  ^^    ^°°^=  (LITERAL, TOKEN); 

ORR?  ,^  ®'^  ^'^    ^=  INTEGER; 

;^^^  II  V'^  ^^       delimiter:  char; 

olll  ^i  !*°  ^^   JUSTIN:  boolean; 

tilt  J^  o*°  ^^   POSSIBLE, pat:  ptype; 

olln  il  V°  ^'*^      usEOLD, verify:  boolean; 

2560  15  8:d  m? 

oltl  }i  '^^'^      ^  PROCEDURE  NEXTCH; 

2562  15  1+9:0      0  BEGIN 

2563  15  -+9:1    0   ch:=getch; 

lltt  U  r=^      ^    ^^    CH=CHR(ESC)  THEN 

2567  J5  IV'l  It                         ^^  ^^'^    ^'JS^If^  ^^^^'^  redisplay; 

256ft  1^  ao.*!  S^                    shovjcursor;    nextcommand; 

l^lt  }l  ,^!'^  28                         EXIT(FIND); 

2569  15  ^9:2  32                    eNQ; 

2571°  II  till  II         ^%<,C^=CHR(EOL))    AND    JUSTIN    THEN 

fs7?  ^^  u!*^  ''^      justin:=false; 

nil  il  IV^  ""^                   BLANKCRTd) 

2574  15  49:2  46      END 

2575  15  49:i  i+g    elSE 

2576  15  49:2  51      WRITE(CH); 

2577  15  49:o  59  END; 

2578  15  49:o  72 

5sln  li  IV'^  ^    PROCEDURE  SKIP; 

2580  15  50:o  0  BEGIN 

2582  is  IVll  J  ^^^^^LE  CH  IN  CCHR(SP),CHR(HT,,CHR(E0L)D  DO  NEXTCH 

2583  15  50:0  30 

2584  15  51  :0  1  PROCEDURE  OPTIONS;                                                             3G'5 


CUD 


<:565 

1 S 

5i: 

2  586 

15 

5i: 

i.'bSl 

Id 

t3i: 

2538 

15 

bi: 

25S9 

15 

5i: 

2590 

15 

51: 

25:>1 

15 

5i: 

2592 

15 

bi: 

2593 

15 

51: 

2594 

15 

5i: 

2595 

15 

bi: 

2596 

15 

51: 

2597 

15 

oi: 

2598 

15 

5i: 

2599 

15 

5i: 

2600 

15 

51: 

2601 

15 

5i: 

2602 

15 

52: 

2603 

15 

52: 

2604 

15 

52: 

2605 

15 

52: 

2606 

15 

52: 

2607 

15 

52: 

2606 

15 

52: 

2609 

15 

52: 

2610 

15 

52: 

2611 

15 

52: 

2612 

15 

52: 

2613 

15 

52: 

261if 

15 

52: 

2615 

15 

52: 

2616 

15 

52: 

2617 

15 

52: 

2618 

15 

52: 

2619 

15 

52: 

2620 

15 

52: 

2621 

15 

52: 

2622 

15 

52: 

2623 

15 

52: 

2624 

15 

52: 

2625 

15 
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1 
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0    tEGIiM 

0  REPEAT 

0  CH:=.jcLC(Ct-i) ; 

6  IF    CHr'L'     THEN 

13      BE3IN  mode:=litekal;  nextch  end 

19      ELSE 

21        IF  CH='V«  THE.M 

26       3EGIN  verify:=true;  nextch  end 

33  ELSE 

35  IF  CH='T'  then 

40  3EGIN  MODE:=TOKEN;  NEXTCH  END; 

H6  CH:=UCLC(CH) ! 

511  UNTIL    NOT    ((CH='VM    OR    (CH='T')    OR    (CH=»L'))J 

68  SKIP; 

70  IF  (CH=»S')  OR  (CH='SM  THEN  USE0LD:=TRUE ; 

84  end; 

93 

1  PROCEDURE  PARSESTRING(VAR  PATTERN:  PTYPE;  VAR  PLENGTH:  INTEGER); 
3  VAR  I,j:  INTEGER; 

0  BEGIN 
0    SKIP; 

2  IF  CH  IN  C'A»..'Z»,»A«..«2' t •0'..»9»»CHR(BS)]  THEN 
31      BEGIN 

31  error( 'invalid  delimiter. ' tnonfatal ) ; 

56  if  not  justin  then  redisplay; 

65  nExtcommand; 

67  exit(find); 

71  end; 

71  delimiter:=ch; 

75   i:=o; 

78    repeat 

78    nextch; 

80  IF  CH=CHR(BS)  then 

87  BEGIN 

87  IF  (PATTERNCI3<>CHR(E0L) )  AND  (I>0)  THEN  (*  DON»T  GO  OVERBOARD!  *) 

98  BEGIN 

98  WRITEC  •.CHR(BS)); 

116  i:=i-i 

117  END 

121  ELSE  CONTROL(FS);  (*  ViAKE  UP  FOR  THE  <BS>  NEXTCH  WROTE  OUT  *) 

127        END 


262b  15  b2:2  127      ELSE! 

2527  lb  52:3  129        BESIinI 

2623  15  b2:t+  123          PATTERTJC 1 3 :  =CH  ? 

2629  15  52:4  133  i:=I+l 

2630  15  52:3  134-        rf^D; 

2631  15  52:i  136    UNTIL  ( CH  =  DELIMITEf< )  OR  (  I  >  =  MAXSTRIMG )  ; 
<i632  15  b2:i  149    IF  I>=r^AXCHAR  THEN 

2633  15  52:2  156      BEGIW 

2634  15  52:3  155        ERRORCYOUR  PATTLRN  IS  TOO  LONG  ♦.  NONFATAL)  ; 

2635  15  32:3  187        IF  NOT  JUSTIN  THLN  REDISPLAY; 

2636  15  52:3  196        NEXTCOMMANDS  EXIT(FIND) 

2637  15  52:2  202      ENDS 

2638  15  32:i  2(J2    PLENGTh  :  =  1-1 ; 

2639  X5  52:0  207  END  (*  ParSESTRING  ♦); 

2640  15  52:0  222 

26'+l  15  53:D      3  FUNCTION  OK(PTR:  PTRTYPE):  BOOLEAN; 

2642  15  53:D      4  (*  COMPARE  PAT  AGAINST  THE  BUFFER  *) 

aSi+S  15  53:D      4  VAR  I:  INTEGER; 

2644  15  53:0      0  BEGIN 

2645  15  53:i     0    i:=o; 

^tnt  }i  11'^               ^         ^»ILZ    (KPLENGTH)  AND  ( EBUF^CPTR  +  1 3=PATC 1 3)  DO  i:=l  +  l; 

2647  15  53:i  29    0K:=  I=PLENGTH; 

2648  15  53:0  36  END; 

2649  15  53:0  50 

2650  15  54:D      1  PROCEDURE  SKIPKIND3( VAK  CURSOR:  PTRTYPE); 

2651  15  54:0      0  BEGIN 

itll  li  l"^'^               °    ^*  ^^^P  °^^^  ^'^^^^    CHARACTERS  IN  THE  EBUF,   UPDATE  THE  CURSOR 

26b3  15  54:o      0       TO  THE  FIRST  N0N-KIND3  CHARACTER                            *} 

itll.  II  IV'^              °    "^^^^  EBUF-CCURSORa  IN  CCHR  {  SP)  ,CHR  (  HT)  ,CHR(DLE)  .CHR  (EOL)  3  DO 

2655  15  54:2  18      IF  EbUF'CCURSOR D=CHR ( OLE )  THEN  CURSOR :=CURS0R+2 

2656  15  54:2  29      ELSE  CURSOR : =CURS0R+1 ; 

2657  15  54:0  42  END; 

2658  15  54:o  56 

2659  15  55:d      1  PROCEDURE  SCANBACKWARD; 

2660  15  55:D      1  LABEL  i; 

2661  15  55:C      1  VAR 

2662  15  55:D      1    LOC:  PTRTYPE; 

2663  15  55:D      2    CHTHERE:  BOOLEAN; 

2664  15  55:0      0  BEGIN 

2665  15  55:i      0    CHTHERe:  =TRUE ;  00-, 

2666  15  55:i      3    THERE :  =FALSE  ;  '=^tj7 


d  u  ^ 


^-l  I     .1  11'^  ^   fillcharcpatcod.sizeofcpat),'  m; 

All  \l  11'^  ^^  '"'^^^^    CHTHEPE    A>gD    NOT    THERE    CO 

2672  \l  Xi'-l  11  ^'     ^^    PTR>=PLENGTH    THEN     (♦    POSSIBLY    THERE    *) 

AA  1^  ll:l  LOC:=SCAN(-PTRi=PATC03,EBUF-CPTRD) 

«ioro  lb  b5:3  bo  ELSE 

lllX  1^  ^5  =  '+  70  LOC:=-PTR! 

5'7t  ^R  ^^:^  ^^  ^"^  LOC  =  -PTR  THEN  (*  NOT  THERE!  ♦) 

2o76  15  55:tf  84  3EGIW 

pft?!  i^s  IV.?  ^"^  chthere:=false;  there:=false 

2678  15  55:1  87  FmO 

2679  15  55:3  91  ELSE 

2680  15  55m  93  3EGIN 

nil  \l  ll\l  ^^  ptr:=ptr+loc;  next:=ptr-i; 

2683  15  55*5  \ll  M    ^BUF-CPlR-l D=CHR ( OLE)  THEN  BEGIN  PTR:=NEXT;  GOTO  1  END 

26^'  is  55;'  1^3  ,ND     '          '          ''  THERE:=TRUE  ELSE  PTR:=NEXT 

2685  15  55:2  149  end; 

2686  15  55:0  151  end; 

2687  15  55:0  168 

Itll  \l  !^'°  ^  PROCEDURE  scanforward; 

2689  15  56:D  1  LABEL  i; 

2690  15  56:D  1  vAR 

f^!l  ^l  ^^'^  ^  maxscan,loc:  integer; 

2692  15  56:d  3  CHTHERE:  BOOLEAN; 

2693  15  56:0  0  BEGIN 

269'+  15  56:i  0  chthere:=tpue; 

2695  15  56:i  3  THERE  .*  =FALSE  ; 

m%  )l  V"''^  ^  f'lLLCHARCPATCO^.SlzEOFCPAT),'  •); 

olll  }l  if'^  ^^  WOVELEFT(TARGETCSTART:,PATCOD,PLENGTH); 

illt  it  i^'^  ^^  ^^^^^    CHTHERE  AND  NOT  THERE  DO 

2699  15  56:2  40  BEGIN 

?7n?  II  it'i  '^^  ^-  "AXSCAN:  =  (BUFC0UNT-PLENGTH)-PTR+1; 

t7nl  Tr  lt:f  ^^  ^^    MaxSCAN>0  then  <*  STILL  STUFF  TO  SCAN  *) 

iyr^i  .1  If't  ^^  L0C:=SCAN(MAXSCAN,=PATC0D,£BUF''CPTRD) 

d7U5  15  56:3  72  ELSE 

2705  15  tV't  It  r    L0C:=MAXSCAN;  (*  DUMMY  UP  'NOT  FOUND'  CONDITION  *) 

57^f  -"-^  -^'^  79  IF  LOC  =  MAXSCAN  THEN 

2707  is  ?t;3  n  elIe^^''  chthere:=fal.se;  there:=false  end 


27LI8  15          b6:'+  93  ailSlN 

fill  \l       ^V^  ^^  '~ptr:=loc+ptr;   next:=ptr+i; 

^111  ll          ll'l  \ll  V    ^^^^'^'=P^''-1J=CHR(DLE)  THEN  BEGIN  PTR:=NEXT;  GOTO  1  END; 

2712  15    56:\  1^3  ^^\'    °'<'^'^'^'  ^''^'^  THEKE:=TRur  ELSE  PTR;=NEXT 

2713  15    56:2  149     END; 
271^+  15    56:3  151  rr^iD; 
2715  15    56:o  168 

571^7  ^.l        IV^  ^   PROCEDURE  goforit; 

2717  15    57:D  1 

Vlll  \l         K«:^  ^  PROCEDURE  NEXTLINE; 

2720  15    'sio  J  ^eg?n'''  ^"^^"^'^f^^'  CALCULATE  THE  START  AND  STOP  FOR  THE  NEXT  LINE  *, 

nil  \l       IV'^  °       lastpattern:=false; 

till  \l  IV'^  **       start:=nextstart; 

272.  is  IVA  \l         ^F^STOP-TLeLg^hTt^^^^ 

2725  15  58:i  72    HZy^VsTt.'^l^^S^^^^^^  LASTPATTERN:=TRUE  END; 

2726  15  58:0  80  END; 

2727  15  5810  92 

nil  \l  IV''  ^    PROCEDURE  NEXTTOKEN; 

2730  ll  ll\l  I    bEG^N^^'^  NEXTSTART,  CALCULATE  START  AND  STOP  *) 

V-tW  \l  -!'^  °   lastpattern:=false; 

llll  ]l  ll'^  '^       start:=nextstart; 

273^  is  IV^  ?n    IL^^^""    °^^"  LEADING  KIND3  CHARACTERS  *) 

2735  is  59:2  \l         '"sTAr|'=S?aRt'I-''^  ''  ^CHR ( SP, ,CHR ( EOL ) ,CHR ( HT) 3,  AND  (START<TLENGTH.l ,  DO 

nil  \l  IV^  '*®   stop:=start; 

Vlll  \l  IV.\  l"!         **  ^^"^  ^^^  ^^^T  TOKEN  *) 

2739  i'  ll'A  93    '"^!^^p:!^J^g^JJRe^T':STARTD3  =  KlNDCTARGETCST0P*13D)  AND  {STOP<TLENGTH.l ,  DO 

274?  is  %V'\  J?f      stop:=;In(stop;tlength-i); 

^7.2  is  slli  iil          '*    c'SAR'ACTESs't}    '"''    '°"    '"'    "-'''    ™^^*    ^^^^    ^''    '^^    ^Rl^lLim    KIND3 

Vrll  \l  IV^  ^^^       nextstart:=stop+i; 

2745  15  lV-\  \ll         ^'^^'-^    (TARGETCNEXTSTARTD    IN    CCHR  { EOL)  ,CHR  (SP)  ,  CHR  (HT)  D)    AND 

2746  is  59:i  ^l         re            <  N"TSTART<TLENGTH )    DO    NEXTSTART:  =NEXTSTaRt!i  ; 

2747  is  silo  iel    ,nd;    ^^^TSTART=TLENGTH    THEN    BEGIN    ST0P:=MAX ( STOP. 0 ) ;    LASTPATTERN:=TRUE    END; 

2748  15  59:0  206                                                                                                                                                                                                                    2G9 
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2751 

15 

b7:i 
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15 

57;  1 

10 

2753 

15 

57:2 

10 

2754 

15 
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16 
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57:2 

33 

2757 
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57:4 
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15 

57:4 

67 

2762 

15 
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71 

2763 

15 
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81 

2764 

15 

57:6 

81 

2765 

15 

57:6 

94 

2766 

15 

57:6 

104 

2767 

15 

57:6 

109 

2768 

15 

57:6 

121 

2769 

15 

57:6 

131 

2770 

15 

57:6 

146 

2771 

15 

57:7 

157 

2772 

15 

57:6 

157 

2773 

15 

57:7 

163 

2774 

15 

57:5 

177 

2775 

15 

57:3 

179 

2776 

15 

57:3 

179 

2777 

15 

57:3 

179 

2778 

15 

57:2 

179 

2779 

15 

57:5 

205 

2780 

15 

57:6 

205 

2781 

15 

57:6 

220 

2782 

15 

57:7 

223 

2783 

15 

57:8 

253 

2784 

15 

57:6 

257 

2785 

15 

57:6 

268 

2786 

15 

57:7 

302 

2787 

15 

57:5 

306 

2788 

15 

57:1 

306 

2789 

15 

t7:o 

316 

:^EGirj(*  90F0RIT  *) 

found:=false; 
next:=ptr; 

REPEAT 

PTR:=iiLXT;  (t  SET  TO  WEXT  PLACE  TO  SCAN  FOR  *) 

nextstart:=o;  (*  fool  nextline  into  giving  us  start  and  stop  for  line  1  ♦) 

IF    w!0DE  =  LITERAL    THLN    NEXTLI'ME    ELSE    NEXTTOKENj 

plength:=stop-start+i; 

if  directi0n='>«  then  scanforward  else  scanbackward ; 

IF  There  then 

3EGIN 

couldbe:=ptr; 

found:=true; 

while  (not  lastpattern)  and  found  do 

BEGIN 

if  m0de=literal  then  nextline  else  nexttoken; 

ptr:=ptr+plength; 

skipkind3(ptr) ;  (*  go  past  the  junk  on  the  next  line  *) 

plength:=stop-start+i;  (*  for  the  new  line  ♦) 

FILLCHAR(PATC0]»SIZE0F(PAT),'  •); 
M0VELEFT(TARGETC START d»patco:,plength) ; 
IF  ptr+plength  >  bufcount  then 

found:=false 
else 
IF  not  ok(ptr)  then  found:=false; 
end; 
end; 
(*  IN  TOKEN  MODE  MAKE  SURE  THE  FIRST  AND  LAST  CHARACTERS 

OF  THE  TARGET  ARE  ON  'TOKEN  BOUNDARIES'  *) 
IF  MODE=TOKEN  THEN  IF  KINDCPATC 0 D3=0RD( ♦ A • )  THEN  IF  FOUND  THEN 
BEGIN 

IF  ((C0ULDBE>2)  AND  (  EBUF'*CC0ULDBE-23<>CHR  (  DLE  )  )  )  OR 

(c0uldbe<=2)  then  {*  whew!  *) 
if  kindcebuf"cc0uldbej3=kindcebuf'^cc0uldbe-1d3  then 
found:=false;  (*  false  find...  don't  count  it.  *) 
IF  (ptr+plength<=8Ufcount-1)  and 

(kindcebuf''cptr+plength-13d=kindcebuf^cptr+plengthdd)  then 
found:=false;  (*  another  false  find  *) 

END; 
UNTIL  FOUND  OR  NOT  THERE; 
END(*  GOFORIT  *) ; 


o 
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^792  15  bSlo  I  3EGIN°'^^'^  PUTPRO^PT  (  uEFT  ,  RIGHT  :  STRING  i  HEPEATFACTOR  :  INTEGER  ;  LORT  :  BOOLEAN)  ; 

2793  15  6o:i  0  promptline : =LEFT ;  prompt; 

^'79<+  lb  bO;i  20  WRITECCM; 

2796  15  &5;J  51  Jr/^^H^^-^I  '^'^^^    WRITE(V')  ELSE  ^RITE  <  REPEATFaCTOR  )  ; 

279l  II  loll  10^  jRifciJHTr"  ^°'^^  =  ™^^  '^'^    WRITECLdTM  ELSE  WRITE  ( 'T  ( OKM  ; 

2799  15  SO:o  113  END; 

2800  15  60:0  126 

2801  15  &1:D  1  PROCEDURE  REPLACEIT; 

2802  15  S1:d  1  LABEL  i; 

2803  15  6l:o  0  BEGIN 

280^  15  Sl:i  0  IF  VERIFY  THEW 

2805  15  61:2  6  BEGIN 

otny  J=  tV.l  °  CENTERCURSOR(TRASH, MIDDLE. NOT  JUSTIN); 

2808  1^  '^i  11  PUTPROMPTC  REPLACE •.  KESO  ABORTS,  'tR'*  REPLACES,  ••  ••  DQESN»»T'. 

panq  ^l  l\:l  II  REPEATFACTOR-I+2, FALSE); 

2S09  15  6i:3  82  SHOWCURSOR; 

2810  15  6i:3  85  CH:=GETCH; 

2811  15  Si:3  92  IF  CH=CHR(ESC)  THEN 

2812  15  6l:^  99  3EGI1M 

ll\l  ]l  tV:l  ,!?  GETLEADING;  CURSOR  :=MAX  ( CURSOR  ,STUFFSTART)  ; 

ll]Z  ^=  ^1-^  111  nextcommand;  exit(fino) 

2815  15  6l;t+  117  END; 

ll\^  \l  tV'^  ^^^  ^^  (Cho'rm  and  (cho'rm  then 

2817  15  61:4  126  BEGIN 

2819  is  IV'X  \l\  REPEATFACT0R:=REPEATFACT0R  +  1;   (*  20-JUN-78  DON'T  COUNT  FALSE  HITS  *) 

2820  15  61:^  133  END;^°  ^' 

2821  15  &l:2  133  END; 

m\  J!  ^^'^  ^^^  ^*  'REPLACE  TARGET  WITH  SUBSTRING  *) 

ilil  W  iV^  ^^^  ^^  SLENGTH>CURS0R-LASTPAT  THEN 

282^  \l  A'-l  \ll  ^^    SLENGTH-(CURSOR-LASTPAT)+BUFCOUNT>BUFSIZE-200  THEN 

^oco  I'D  ol.3  159  BEGIN 

2^27  \l  IV'l  W'  ERRORCBUFFER  FULL.   ABORTING  REPLACE' , NONFATAL)  ; 

?fl?q  1?  l\'.l  \ll  GETLEADING;  CURSOR :  =MAX(CURSOR,  STUFFSTART)  ; 

ilol  \l  .,  i  ^°^  NEXTCOMMAND;  EXIT(FIND); 

282-:?  15  =1:3  2m  END 

2830  15  61:2  214  ELSE                                                                 37l 


Z12 


2831 

lb 

bl 

3 

21;', 

2332 

13 

61 

1 

229 

2633 

13 

&1, 

2 

231 

283'+ 

lb 

bl' 

3 

240 

2835 

15 

61 

.1 

253 

2836 

15 

61 

:i 

264 

2837 

15 

61 

:2 

273 

2838 

15 

61 

:i 

26  4 

2839 

15 

61 

:i 

295 

28'+0 

15 

61 

;i 

306 

28'+! 

15 

61 

:i 

310 

2842 

15 

61 

:i 

324 

28H3 

15 

8 

:o 

0 

2844 

15 

8 

;i 

0 

2845 

15 

8 

:i 

3 

2846 

15 

8 

;i 

6 

2847 

15 

8 

:i 

10 

2848 

15 

8 

:i 

14 

2849 

15 

8 

;i 

27 

2850 

15 

8 

:2 

32 

2851 

15 

8 

;i 

58 

2852 

15 

8 

12 

62 

2853 

15 

8 

11 

102 

2854 

15 

8 

11 

106 

2855 

15 

3 

:i 

110 

2856 

15 

8 

:i 

112 

2857 

15 

8 

;2 

118 

2858 

15 

8 

;3 

118 

2859 

15 

8 

:3 

126 

2860 

15 

8 

:2 

126 

2861 

15 

8 

:i 

130 

2862 

15 

a 

\2 

135 

2863 

15 

8 

:3 

135 

2864 

15 

8 

:3 

139 

2865 

15 

8 

13 

143 

2866 

15 

8 

:3 

145 

2867 

15 

8 

'4 

151 

2868 

15 

8, 

"5 

151 

2869 

15 

8; 

5 

159 

2870 

15 

a: 

4 

159 

2871 

15 

8: 

2 

163 

EL 


MO 

IF 

BU 
CU 
JU 


MOVE 
SE 
IF    SLE 

MOVE 

VELEFT 

SLE!\IG 

readju 

FCOU^JT 

RSOR 

stin:= 


RIGHKE.uUF'^C  CURSOR  J,  EBUF'^CLASTPAT  +  SLEN&THD.bUFCOUNT-CURSOR) 

NGTH<CURSOR-LASTPAT    THEN 

LEFT  (EEUF'^C CURSOR :,EBUF'^CLASTPAT  +  SLENGTH],BUFCOUNT-CURSOR); 

(SUaSTRlNGCOn.EBUF'^CLASTPATD.SLENGTH)  ; 

THOCURSOR-LASTPAT    THEN 
ST(LASTPAT,SLENGTH-(CURSOR-LASTPAT) ) ; 
:=BUFCOUNT+SLENGTH-(CURSOR-LASTPAT) ; 
:=CURSOR       +SLE1MGTH-{CURS0R-LASTPAT)  ; 
FALSE; 


i:end; 


BEGIN 

alreadysaidgo:=false?  (*  ok  to  go  on  without  asking!  *) 

justin:=true; 

useold:=false; 

verify:=false; 

IF    PAGEZERO.TOKDEF    THEN    M0DE:=T0KEN    ELSE    M0DE:=LITERAL ! 
IF    COM^AND=FINDC    THEN 

PUTPROi^PTC    FIND'*'    <TARGET>      =>•  »REPEATFACToR«  TRUE  ) 

ELSE 

PUTPROMPTC  REPLACE* t»  ViFY  <TARG>  <SUB>   =>• tREPEATFACTOR t TRUE ) ! 

needprompt:=true; 
nextch;  skip; 

OPTIONS; 

IF  NOT  USEOLD  THEN 
BEGIN 

parsestring(target,tlength) ; 
toefined:=true 
end; 

IF    CO^fJlAND  =  REPLACEC    THEN 
BEGIiM 

nExtch;  SKIP; 

USEOLO:=FALSE; 

OPTIONS; 

IF  NOT  USEOLD  THEN 

3EGi;g 

PARSESTRlNG(SUBSTRlNGiSLENGTH) ; 

sdlFined:=thue 

END 

end; 
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1  ba 
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263 

276 
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HOME; 

CLEARLl!\|E(0)  ; 

IF  (  (C3,'>iVIAiMD  =  FINDC)  AND  TDEFINED) 

OR  (  (COviWAi\ID  =  REPLACEC)  AND  SDEFINED  AND  TDEFINED)  THEN 

BEGliNj 

i:=i; 

found:=true; 

ptr:=cursor; 

WHILE  ( (I<=REPEATFACT0R)  QR  INFINITY)  AND  FOUND  DO 

3EGIN 

GOFORIT;  (*  FIND  THE  TARGET  (HANDLES  TOKEN  AND  LITERAL  MODE)  *) 

i:=i+i; 

IF  FOUND  THEN 
BEGIN 

cursor:=htr+plength;  lastpat:=couldbe;  (*set  up  for  next  time*) 

IF  COMMAND=REPLACEC  THEN  REPLACEIT; 

IF  DIRECTI0N=«<»  THEN  PTR:=C0ULDBE-1  ELSE  PTR:=CURSOR; 
END 
ELSE 
BEGIN 

IF  (DIRECTI0N='>')  AND  (RPAGE<FLENGTH) 
OR  (DIRECTI0N=»<')  AND  (LPAGE>0)  THEN 
BEGIN 

IF  ALREADYSAIDGO  THEN  CH:='Y» 
ELSE 
BEGIN 

MS6:='END  OF  BUFFER  ENCOUNTERED,  GET  MORE  FROM  DISK?  (Y/N)»; 
HUTMSG;  *i^  '  . 

ALREADYSAIDGO :=TRUE; 

REPEAT  CH:=UCLC(GETCH)  UNTIL  CH  IN  C*Y'.«N'3} 

END ; 

IF  CHr'Y'  THEN 
BEGIN 

JUSTlN:rFALSE;  (♦  FORCES  REDISPLAY!!!  *) 

msg:=»finding»;  putmsg; 

F0UrjD:=TRUE5 

i:=I-l;  (*  REALLY  HAVEN'T  FOUND  ANYTHING  *) 
IF  DlRECTION='>'  THEN 
BEGIN 

CURSOR:=BUFCOUNT-l; 
PUTPAGES(LEFTSTACK); 
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Ziio  15  a:i  430  GETPAGESCRIGHTSTACK) ; 

^914  Id  3:2  -+3^  END 

2915  15  8:i  454  t-LSE 

291fc  15  b:2  43o  BEGIN 

2917  15  8:3  43S  CURSOR:=l; 

2918  15  8:3  459  PUTPASES { RIGHTSTACK ) ; 

2919  15  8:3  445  GETPASES ( LEFTSTACK ) 

2920  15  3:2  444  END; 

2921  15  8:i  4h7  PTR:=CURS0R 

2922  15  8:0  447  END 
2925  15  8:9  450                     ELSE 

2924  15  8:0  452  GOTO  15 

2925  15  8:a  454  END  (♦  ...  OR  ...  *) 

2926  15  8:6  454  END  (*  IF  FOUND  THEN  ...  ELSE  ...  *) 

2927  15  8:4  454  END;  (*  WHILE  •••  *) 

2928  15  8:3  456        IF  NOT  FOUND  THEN 

2929  15  8:4  460  IF  NOT{  INFINITY  AND  (I>2)  )  THEN 

2930  15  8:5  470  BEGIN 

2931  15  8:6  470  IF  ALREADYSAIDGO  THEN 

2932  15  8:7  473  BEGIN  (*  CURSOR  INVALID  *) 

2933  15  8:8  473  CURS0R:=1; 

2934  15  8:8  476  JUSTIN : =FALSE ; 

2935  15  8:7  479  END; 

2936  15  8:6  479  ERROR( 'PATTERN  NOT  IN  THE  FILE' t NONFATAL) 

2937  15  8:5  506  END; 

2938  15  8:2  509      END 

2939  15  8:i  509    ELSE 

2940  15  8:2  511      ERROR('NO  OLD  PATTERN. ♦ .NONFATAL) ; 

2941  15  8:i  533   i:  getleading; 

2942  15  8:i  536    CURSOR: =MAX ( STUFFSTART , CURSOR ) ; 

2943  15  8:i  545    CENTERCURSOR ( TRASH, MIDDLE t NOT  JUSTIN); 

2944  15  8:i  555    SHOWCURSOR; 

2945  15  8:i  553    NEXTCOMMAND 

2946  15  8:0  558  END; 

2947  15  8:o  584 

2948  15  8:0  534    {*$TC    OM^AND  INTERFACE*) 

2949  15  8;0  584 

2950  15  2:D      1  PROCEDURE  NEXTCOMMAND; 

2951  15  2:0      0  3EGIN 

2952  15  2:1      Q    IF  NEEpPROMPT  THEN 

2953  15  2:2      5      BEGIi^i 
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2 

:i 
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2 

:o 

114 

2 

:o 

126 

62 

:d 

1 

62 

:o 

0 

62 

:i 

0 

62 

:i 

4 

62 

\2 

9 

62 

:i 

18 

62 

:2 

20 

62 

;i 

37 

62 

:i 

40 

62 

:i 

50 

62. 

;i 

54 

62; 

'1 

58 

62 

1 

62 

62. 

1 

66 

62 

1 

70 

62. 

1 

74 

62. 

1 

78 

62: 

1 

82 

62: 

1 

86 

62; 

1 

90 

62: 

1 

92 

62: 

1 

96 

62: 

1 

100 

62: 

1 

10*+ 

62: 

1 

108 

62: 

1 

112 

62: 

3 

112 

62: 

1 

115 

62: 

3 

118 

62: 

3 

127 

62: 

3 

137 

PRQ^:PTLlfji::  = 
•  EIDIT:  A(0JST  C(PY  D(I.ETl  F(IND  KNSRT  J(MP  R(PLACE  Q(UIT  X(CHNG  Z(AP   CL.23»; 
PRQN-PT; 

N£E:DPROi*^PT:=FALSt.! 
SHOWCUHSOR 

end; 
ch:=getch; 

co^mand:=maptocommanl)(ch)  ; 
end{*  nextcommand  *) ; 

procedure  commander; 

3EGIN 

infinity:=false; 

IF  command=slashc  then 

BEGIN  REPEATFACToR5=1;  INFINITY: =TRUE 5  NEXTCOMMAND  END 
ELSE 

IF  command=digit  then  repeatfactor:=getnum  else  repeatfactor:=i; 

CASE  command  of 

illegal:  begin  errwait;   sho^icursor;  nextcommand  end; 
reversecforwardc:  fixdirection; 

BANISHC:  BANISH; 

coPYc:  copy; 

dumpc:  dump; 

FiNDc:  find; 

insertc:  insertit; 

JUMPc:  jump; 

listc:  nextcommand;  (♦  not  yet,  depends  on  terak  pan  *) 

MACRODEFC:  DEFMACRO; 

NEXTc:  next; 

Quitc:  ;  (*  exit  handled  in  outer  block  *) 

replacec:  find; 

setc:  setstuff; 

verifyc:  verify; 

xecutec:  xmacro; 

ZApc:  zapit; 

equalc;  begin 

cursor:=lastpat; 

getleaoing; 

cursor :=MAX( cursor, STUFFSTART) ; 

CEmtERCURSOR(TRASH, middle, FALSE)  ;  ^7^: 

sho^cursor;  nextcommand  '" 


'~>  '^  '» 

c  /  n 


2995 

15 

'o2:^ 

2  996 

15 

n2;i 

2997 

1  '^ 

62:1 

^998 

15 

62:o 

2999 

15 

62:o 

3000 

15 

i:o 

3001 

15 

i:i 

3002 

15 

i:i 

3003 

15 

i:o 

300'+ 

15 

i:o 

3005 

15 

i:o 

3006 

15 

i:o 

3007 

i:o 

3008 

12:d 

3009 

12:0 

3010 

12:1 

3011 

12:0 

3012 

12:0 

3013 

13:d 

3011+ 

13:0 

3015 

13:1 

3016 

13:0 

3017 

i3:c 

3018 

h:d 

3019 

'+:d 

3020 

t+tO 

3021 

4:1 

3022 

'*:i 

3023 

f  :i 

302i+ 

4:0 

3025 

'+:o 

3026 

8:d 

3027 

8:0 

3028 

8:1 

3029 

a;2 

3030 

8:3 

3031 

8:3 

3032 

8;  3 

5033 

8:"+ 

3034 

8:4 

3035 

a:5 

1^14      AD  JU'STCOELCTECPAK  AC,  UP  .DOWiJ,  LEFT,  RIGHT,  ADVANCE,  TAB.  SPACE:  MOVE  I T 
l^^    END  (*  3IG  LONG  CASE  STATE^lENT  ♦); 
216  END  (*  C0M.'*1ANDER  *); 
230 

0  begin  (*  eoitcore  *) 

0   nextcomn-and; 

2  while  co^i'^andoquitc  do  commander 

7  end; 

26 

26 

26    (*$TM    ISC.       PROCEDURES       (INCL.    SCREEN    CONTROL)    ♦) 

26 

3  FUNCTION  MIN(*  ( A  ,  B : INTEGER ) I  INTEGER  *)J 
0  3EGIN 

0    IF  A<B  THEN  MIN:=A  ELSE  MIN:=3 

10  end; 

26 
3  FUNCTION  MAX  (*( A, B: INTEGER >: INTEGER* ) ; 
0  BEGIN 

0   if  a>b  then  max:=a  else  max:=3 
10  end; 

26 
3  FUNCTION  GETCH(*:CHAR*) ; 

3  vAR  gch:  char; 

0  BEGIN 

0    READ(KeyBOARD,GCH) ; 

8  IF  EOLN(KEYBOARD)  THEN  GCH:=CHR ( EOL ) ; 

21  getch:=gch; 
24  end; 

36 
3  FUNCTION  mAPTOCOMMAND(*  (CHtCHAR):  COMMANDS  *); 
0  BEGIN 
0    IF  (CH=srSCOM'*,CRTCTRL. ESCAPE)  AND  (CH<>CHR(0))  THEN 

16      BEGIN 

16      ch:=getch; 

22  IF  cH=SYSCOM'*.cRTINFO,LEFT  THEN  MAPTOCOMMAND:=LEFT 
^^                    ELSE 

39  IF  CHrSYSCOM'^.CRTlNFO. right  THEN  MAPTOCOMMAND :  =R IGHT 

51  ELSE 

56  IF  CH=SYSCO"".CRTINf   UP  THEN  MAPTOCOMMAND:=UP 


50i6  1  3:b  &b  ELSE 


IF    CH  =  SrsCUM'^.CRTl\lFO.DOwN    THEN    MAPTOCO:'/|W|AND :  =DOWN 


3037  1  8:6             7 

3u38  1  8:6            hi                                     LLSl 

5039  1  6:7            90                                          MAPTOCOf^iMAND  I  =  ILLEGAL 

30^+0  1  8:2            50               END 

3041  1  8:i            35          ELSE 

^^'^^  1  3:2            35               •MAPTDcOM,v|ANU:=TRANiiLATEi:CH]5 

30'+3  1  8:o  1U4    rND; 

3044  1  8:0  116 

^Jj;^  J  l'^              3    FUNCTION    UCLC(*(CH:chAR):cHAR*);     (*    MAP    LOWER    CASE    TO    UPPER    CASE    *) 

3046  1  9:0               0    3EGIN 

nil  J  |:J               Q          !•;    CH    IN    C«A'..»Z»3    THEN    UCLC  :=CHR  ( ORD(  CH) -32)    ELSE    UCLC:=CH 

3049  1  gjo     tta 

3050  1  14:D      1  PROCEDURE  CONTROL ( *CH ICTYPE* ) ; 

Inll  I  ]'*'°              ^    **  ^^SED  ON  THE  PARAMETER  PASSED,  USE  CRTCTRL  TO  PUT  OUT  THE 

3052  1  14:D      2     APPROPRIATE  CONTROL  CODE  FOR  THE  HOST  TERMINAL  ♦) 

3053  1  14:o      0  BEGIN 

3054  1  14:i      0    WITH  SYSCO'V!^, CRTCTRL  DO 

3055  1  14:2      7      SEGIM 

3056  1  14:3      7        IF  ESCAPEOCHR  ( 0 )  THEN  WRITE  ( ESCAPE )  ; 

3057  1  14:3  26        CASE  CH  OF 

3058  1  1413  29          fS.*      WRITE(NDFS); 

3059  1  14:3  44          SOHOME:  WRITE(HOME); 
lnt°  1  I'+'S  57          ETOEOL:  WRITE(tRAsEEOL); 

3061  1  14:3  72          ETOEOS:  WRITE ( LRASEEOS ) ; 

3062  1  14:3  87          js:      WRITE(RLF) 

3063  1  14:3  100        END 

3064  1  14:2  120      END 

3065  1  i4:o  120  end; 

3066  1  14:0  132 

Intl  J  ^='°  ^^^  ^*  '-°°^  ^"^  "^'  '-°°'^  A"^  "^'  LOO"^  '^T  ^^^-    LOOK  AT  ME!  LOOK  AT  ME!  LOOK  AT  ME!   ♦) 

3068  1  5:D      1  PROCEDURE  CLEARSCREEn; 

^°^^  J  ^:^      1  <*  SET  THE  SCREEN  TO  ALL  BLANKS  AND  LEAVE  THE  CURSOR  IN  THE  UPPER  LEFT-HAND 

J°^?  J  l:^               1     CORNER  (0,0).   NOTE  THAT  THE  CONTROL  CODE  FOR  THIS  OPERATION  IS  HARD- 

t^^t  .  i:'^               ^            '""^^^^  *^*^*  ^^  DOESN'T  GO  THROUGH  SYSCOM),  AND  THUS  ENTAILS  A  RECOMP- 

^^'^  i  ^''^               1     ILATION  TO  CHANGE  TERMINALS.   P.S,  12  IS  A  FF,   *) 

3073  1  5:0      0  BEGIN 

^°7'+  1  5:i      o    WRITE(CHR(12)) 

3075  1  5:o     8  end:                                                         _.,^ 

3076  1  5:0  20                                                                          277 


'?7'^ 


^*377  1  7:d  1  pROCCDUR;  CL£.ARLirJE(*Y:i[JTEGER*)  ; 

5078  1  7:D  2  (*  if  YOJH  T,-RMINAL  hAS  AN  ERASELI^iE  CAPABILITY;  THAT  IS  A  CONTROL  CODE 

3079  1  7:D  2  THAT  /JILL  CLEAR  THE  LI.NE  THE  CURSOR  IS  ON,  AND  LEAVE  THE  CURSOR  AT 

^^^^  1  7::.  2  THE  FIRST  COLUMN  (OiY)  THEN  SUBSTITUTE  THIS  CODE  WITH  A  SINGLE  CHARACTER 

i081  1  7:d  2  /JRITE  *) 

3082  1  7:0  0  BEGIN 

3033  1  7:0  0  (* 

•508'+  1  7:0  0  IF  YOSCREENHEIGHT  THEN  UNl  TWRITE  (  2 ,  BLANKAREA  .  SCREENWIDTH  +  1 ) 

5035  1  7:0  0  ELSE  UnI  TWRITE  ( 2 .  3LANKAREA » SCREENkJiDTH)  ; 

3086  1  7:0  0  GOTOXY(OtY); 

3037  1  7:0  0  ♦) 

3088  1  7:i  0  GOTOXY(O.Y);  CONTROL ( ETOEOL) ; 

3039  1  7:o  8  end; 

3090  1  7:o  20 

3091  1  15:D  1  PROCEDURE  PUTMSG; 

3092  1  15:0  0  BEGIN 

3093  1  15:i  0  CONTrOl(GOHOME) ; 
309«+  1  15:i  3  CLEARLINE(O); 

3095  1  i5:i  6  savetop:=msg; 

3096  1  15:i  14  WRlTE(.wiSG)  ; 

3097  1  i5:o  24  end; 

3098  1  15:q  36 

3099  1  16:0  0  PROCEDURE  HOME;  BEGIN  CONTROL (GOHOME)  END; 

3100  1  16:0  16 

3101  1  3:0  1  PROCEDURE  ERASETOEOL ( *X , LINE : INTEGER* ) ; 

3102  1  3:0  0  BEGIN 

3103  1  3:0  0  {* 

310'+  1  3:0  0  IF  X  =  0  THEN  CLEARLINE  { LINE ) 

3105  1  3:0  0  ELSE 

3106  1  3:0  0  BEGIN 

3107  1  3:0  0  IF  LINE=SCREENHEIGHT  THEN 

3108  1  3:0  0  UNITWRITE(2,BLANKAREA,SCREENWIDTH-X) 

3109  1  3:C  0  ELSE 

3110  1  3:o  0  UNlTwRITE(2,BLANKAREA,SCREENWlDTH-X+l) 

3111  1  3:q  0  end; 

3112  1  3:0  0  GOTOXY(X.LINE) ; 

3113  1  3:0  0  *) 

311'+  1  3:i  0  contrOl(EToeol)  ; 

3115  1  3:0  3  E'Jo; 

3116  1  3:o  16 

3117  1  6:D  1  PROCEDURE  ER ASEOS ( *X , LINE*  )  ; 


2iia  i  &:3  6   vAR  i:  imteger; 

3120  1  6:o  c    (* 

3121  1  6:a  0    ERASETj£OL(X,LII\)E)  ; 

l]il  J  °:J  '-^  ''^R  I:=LINE  +  1  TO  SCRtENHEIGHT  OC  BEGIN  WRITELN;  CLEARLINE(I)  END; 

^^^^  1  oil  0  CONTROl(ETOEOS) ; 

3125  1  6:o  3  END; 

3126  1  6:o  i£, 

3127  1  10:0  1  PROCEDURE  PROMPT; 

3128  1  10:G  0  3E6IN 

3129  1  io:i  0  proniptlineci::=direction; 

3130  1  io:i  &  savetop:=promptline; 

3131  1  io:i  11+  contrOl(GOhome)  ; 

3132  1  10:i  17  CLEARLinE(O); 

3133  1  10:i  20  WRITE(PROMPTLINE) 

313*+  1  10:0  30  END; 

3135  1  10:o  42 

3136  1  17:D  1  PROCEDURE  ERRWAIT; 

3137  1  17:o  0  BEGIN 

3138  1  17:i  0  WRITE(CHR(BELL)); 

3139  1  17:i  8  PROMPT; 

si'io  1  i7:o  10  end; 

3141  1  17:o  22 

31t2  1  18:D  1  PROCEDURE  BLANKCRT(*y:  INTEGER*); 

3143  1  18:o  0  BEGIN 

3144  1  18:o  0  (♦ 

3145  1  18:0  0  IF  Y=l  THEN 

3146  1  18:o  0  BEGIN 

3147  1  16:0  0  CLEARSCREEN; 

3148  1  18:o  0  WRITELN(SAVETOP) 

3149  1  18:o  0  END 

3150  1  18:0  0  ELSE 

3151  1  18:0  0  BEGIN 

3152  1  18:0  0  GOTOXY(0,Y); 

3i5o  1  i8:o  0  eras£:os(o,y); 

3154  1  i8:o  0  end; 

3155  1  ia:o  0  *) 

3156  1  16:i  0  GOTOXY(O.Y); 

3157  1  18:i  5  CONTROl(ETOEOS) 

3158  1  i8:o  6  end;                                                     279 
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5159 

1   i8:c 

20 

51&P 

1    2:j 

1 

5161 

1    2:0 

0 

51S2 

1    2:1 

0 

5165 

1    2:1 

a 

5164 

1    2:2 

13 

3165 

I    2:1 

m 

5166 

L    2:2 

18 

3167 

L     2:1 

23 

3168    : 

L     2:1 

49 

3169 

L     2:2 

54 

3170    : 

L     2:1 

58 

3171 

L     2:2 

60 

3172   : 

L     2:3 

60 

3173    ; 

L     2:3 

108 

3174    ] 

L     2:2 

116 

3175    : 

L     2:0 

120 

3176    ] 

L     2:0 

134 

3177    ] 

L     2:0 

134 

3178    ] 

L     2:0 

134 

3179    ] 

L   19;d 

3 

3180    ] 

L   19:d 

5 

3181    ] 

L    19:D 

5 

3182    ] 

19:d 

5 

3183    ] 

L    19:0 

5 

318*+    ] 

19:d 

5 

3185    ] 

19:d 

5 

3186    3 

19:d 

5 

3187    1 

19:d 

6 

3188    ] 

i9:o 

0 

3189    ] 

i9:i 

0 

3190    ] 

19:1 

6 

3191    a 

19:2 

22 

3192    3 

1913 

22 

3193    ] 

19:*+ 

29 

319H    1 

19:3 

43 

3195    1 

I9;f 

45 

3196    1 

19:4 

53 

3197    1 

19:5 

59 

3198    1 

19:3 

68 

3199    1 

^9:2 

69 

PROCEDURE  ERROR{*S:  STRING ? HOwBAD :  ERRORTYPE*); 
UEGIN 

UNlTCLEARd)  ;  (*  THROW  AWAY  ALL  CHARACTERS  QUEUED  UP  *) 
IF  H0W3A0=FATAL  THEN 

BLANKCRTd) 
ELSE 

3EGIN  HOME;  CLEARLINE(O)  END; 
WRITE( 'ERROR:  '.S); 
IF  H0W3AD=FATAL  THEN 

EXIT(EOITOR) 
ELSE 

BEGIN 

write(»  please  press  <spacebar>  to  continue.'); 
repeat  until  getch='  •;  needprompt :=true 
end; 
end; 

(*$tu  tility   procedure  s*) 

FUNCTION  lEADBLANKSC*  (PTR:  PTRTYPE;  VAR  bytes:  INTEGER):  INTEGER  *)} 
(*  ON  ENTRY- 

PTR  POINTS  TO  THE  BEGINNING  OF  A  LINE 
ON  EXIT- 

FUMCTION  RETURNS  THE  NUMBER  OF  LEADING  BLANKS  ON  THAT  LINE. 
BYTES  HAS  THE  OFFSET  INTO  THE  LINE  OF  THE  FIRST  NON-BLANK  CHARACTER  *) 
VAR 

OLDPTR:  PTRTYPE; 

INDENT:    integer; 

3EGIIM 

oldptR:=ptr;   indent:=o; 

WHILE  0RD(EBUF'"CPTR3)  IN  CHTiSPtDLE:  DO 

BEGIN 

IF  ebuf^cptr3=chr(dle)  then 

BEGIN  ptr:=ptr+i;  indent:=indent+ord(ebuf"Cptr3)-32  end 
else 

IF  ord(EBUF^cptr:)=sp  THEN  indent:=indent+i 

ELSE 

(*HT*)  INQENT:=( (INDENT  DIV  8)+l)*8;   (*  KLUDGE  FOR  COLUMNAR  TAB!  *) 

ptr:=ptr+i 
end; 


3200    1    19:1     75 


BYTES:=pTR-OLOPTR 


•■<?r,i  1  iQ.,  -  ■   ■  <-o  • -r  I  iN-^Uur  I  r\  , 

f.ll  ]  ]l'^  ^^  LEAD3LArjKS;  =  rJ3LMT; 

f^l\  ]  ]l-^  ^^    END(*LEAD3LAigKS*); 

^<i^o  1  19;  0  3B 

nil  \  ]]:":  1    PROCEDURE    REDISPLAY; 

mi  \  \\Vi  1         l-INE:DlST,EOLDlST,LINt:     INTEGER; 

3211  1  11  ^^^'    PTRTYPE5 

3212  1  ulS  0    BEgIn'''^'^^    ''^*'    C0..MAXSW3    OF    CHAR; 


3213         1         ll:i 


0  BLANKCRT(l) 


^si'^  1  ii:i  5  LlHi'll: 

ll\l  \  WW  ^  ptr:=lineiptr; 

3217  1  M  ^  REPEAT 

3218  1  11  ip  oJ  !'-^'^><S:=MIN(LEADBLANKS(PTR,3YTES),SCREENWIDTh)J 

lt\l  1  1?:.  ^^  gotoxy(Blanks,line)j         ^'»^wkllimwiuth}, 

3220  ^  il*o  ^°  ptr:=ptr+bytes; 

3221  1  li.i  11  f0l-DlST:=SCAN(MAXCHAR,=CHR(E0L),E3UF-CPTRD); 

3222  1  ilia  11  \,lf.?lll\l'ltlih'tV^^^^^^^^ 


3223  iJi^  '5  jOVELEFTfEBUF-^CPTRH.TCO^.UNESlST    , 

322?         1         W'-l  I.  ^^    E3UF-CPTR  +  LI|\JEDiSTK>C; 

3225        1         iiip  t\  TC^^AX(0.LINEDIST-1)3:  =  » 


322.         1         11:3^  II  ^%c%^^;S:L'n:EDl|?i?^^^->^^^!"^^    ^^^^    <*    ^'^^   TRUNCATION    *, 

322^    \    ii;f    jf      S"i!iiib3:!^2;?!> 


3227  1  iiM  |?f      „  ptr:=ptr+eoldist+i;  line:=line+i 

3223  1  lii-J  J2I  end;     (LINE>SCREENHEIGHT)  or  (PTR>=BUFC0UNT) 

3229  1  11:0  i3g 

323?  J  oil?  ^  PROCEDURE  CENTERCURSQR 


3232         i         'Sio  :    jr^GURroUT'lF'THr    C  iRSHR^J.^Sx'^P^' \ '^^^^"^^^=    BOOLEAN*,; 

^^^^         i         -^S  ^  I^ir  V      riS  I      sg    r^^^  0S^^r-0Tj^RiIsr;N^^?T.PT 

323I  i  .\°:.^    : ,,,-  th?^j?ua^"^;iJe"tJe^^Sr^s^%°^:i  f^Jr^^o^^o^^ ^r'-  ^^^^  -  --  -°-- 


Ifffl   J   ?S:S     '^   "^^f^^-"  integer; 
3238   1   2o:d     5   ptr:  ptrtype; 


3239    1    20:0 


0  BEGIN 


32'+0    1    20:1      0    IF 


E3UF'^CCURSOR3=CHR(E0L)  THEM  PTR:=CURS0R  ELSE  PTR  :=CURS0R  +  1 ;  ^^^ 


23?. 


ss'+i  1  ^0:1  17       Li^JE:  =  n: 

32'+2  1  20:1  20  REPEAT 

i^'^i  1  20:2  20  ptr:=ptr-i; 

iZ^^  1  20:2  25  PTR:=SCAr^(-MAXCHAR.=CHR(EOL)  ,EBUF'^CPTR])+PTR; 

3245  1  20:2  40  LINE:=LINE+1; 

3246  1  20:2  46  IF  LlrjE  =  LINESUP  THEN  MARK:=PTR; 

3247  1  20:1  55  UNTIL  (  LINE:>SCREENHEIGHT  )  OR  (  ( LINE1PTR  =  PTR  +  1 )  AND  NOT  NEWSCREEN)  OR  {PTR<1); 
3246  1  20:i  76  IF  LINE>SCREENHEIGHT  THEN  U  OFF  THE  SCREEN  *) 

3249  1  20:2  62  BEGI-Nl  LIfJElPTR :  =MARK  +  1 ;  REDISPLAY;  LINE:=LINESUP  END 

3250  1  20:1  93  ELSE 

3251  1  20:2  95  IF  LlNtlPTR=PTR+i  THEN 

3252  1  20:3  104  BE3IN 

3253  1  20:4  104  IF  NEWSCREEN  THEN  REDISPLAY 

3254  1  20:3  107  END 

3255  1  20:2  109  ELSE 

3256  1  20:3  111  BE3IN 

3257  1  20:4  111  LINE1PTR:=1;  REDISPLAY 

3258  I  20:3  115  end; 

3259  1  20:0  117  end; 

3260  1  20:0  132 

3261  1  21:D  1  PROCEDURE  FINDXY(*VAR  INDENTiLlNE;  INTEGER*); 

3262  1  21:D  3  VAR 

3263  1  21:D  3  ItLEAD;  INTEGER; 

3264  1  21:D  5  PTR.EOLPTR:  PTRTYPE; 

3265  1  21:0  0  BEGIN 

3266  1  21:0  0  (*  PLACE  CRT  CURSOR  ON  THE  SCREEN  AT  THE  POSITION  CORRESPONDING 

3267  1  21:0  0  TO  THE  LOGICAL  CURSOR.  *) 
3263  1  21:1  0  LINE:=1; 

3269  1  21:1  3  ptr:=lineiptr; 

3270  1  21:1  a  E0LPTR:=SCAN(MAXCHAR»=CHR(E0L),EBUF'*CPTR])+PTR; 

3271  1  21:1  22  ifJHiLE    EOLPTR<CURSOR    UO 

3272  1  21:2  27  BEGIN 

3273  1  21:3  27  LINE:=LINE+1;  PTR:=E0LPTR+1;  (♦  SET  UP  FOR  THE  NEXT  LINE  ♦) 

3274  1  21:3  38  EOlPTR:=SCAN{|V!AXCHARi=CHR(EOL)  »EBUF^CPTR3)+PTR 

3275  1  21:2  48  end; 

3276  1  21:2  54  (♦  NOW  FIND  THE  INDENTATION  ON  THAT  LINE  OF  THE  CURSOR  *) 

3277  1  21:1  54  LEAD:=LEADSLANKS(PTK»I) ; 

3273  1  21:1  63  INDENT:=MIN{SCREENwIUTH,<LEAD-I)+{CURSQR-PTR) ) ; 

^279  1  21:1  77  {*  (EXTRA  SPACES)  +  (OFFSET  INTO  LINE)  *) 

3280  1  21:0  77  END;(*  FINOXY  *) 

3281  1  ^lio  92 


3282 

1 

■d2:u 

326i 

1 

Zk'.j 

5264 

1 

22:d 

3285 

22:  0 

3286 

22:i 

3287 

22:1 

3238 

22:0 

3289 

22:0 

3290 

23  :d 

3291 

23:d 

3292 

23  :d 

3293 

23:d 

329if 

23:o 

3295 

23:i 

3296 

23:i 

3297 

23:i 

3298 

23:i 

3299 

23:2 

3300 

23:3 

3301 

23:3 

3302 

23:4 

3303 

23:5 

330H 

23:5 

3305 

23:4 

3306 

23:2 

3307 

23:i 

3308 

23:2 

3309 

23:3 

3310 

23:3 

3311 

23:2 

3312 

23:i 

3313 

23:2 

3314 

23:i 

3315 

23  :o 

3316 

23:o 

3317 

24:d 

3318 

24:o 

3319 

24  :o 

3320 

24:o 

3321 

24:o 

3322 

24:o 

1  procedure:  SHOWCURSOR; 

i  v/AR 

1         X,Y:     I\iT£GuR; 

0  bEGIi^ 

0         FlrvDXY(XiY)  ; 

5  GOTOXr(X.Y) 
11  ENO(*    SHOWCURSOR    *) ; 
24 

3    FUNCTION    GtTNUM(*: INTEGER*) ; 

3  VAR 

3       n:   integer; 

4  overflow:    BOOLEAN; 
0    BEGIN 

0   im:=o; 

3   overflow:=false; 

6  IF  NOT  (CH  IN  C'0*,.»9»3)  THE^J  N:=1 
23  ELSE 
28  REPEAT 

28  IF  N  >  1000  THEN  OVERFLOW :=TRUE 

35  ELSE 

"+0  3EGIN 

'^0         n:=n*io+ord(ch)-ord( 'o* ) ; 
■+9        ch:=getch 

'^^  END 

55  UNTIL  (NOT  (CH  IN  C • 0 » . . 'g* 3) )  OR  OVERFLOW; 

73  IF  OVERFLOW  THEN 

76  BEGIN 

76  ERROR( 'REPEATFACTOR  >  10 . 000 », NONFATAL) J 

103      getnum:=o; 

106      END 

106    ELSE 

108      GETNU^:=N; 

\'^.l       ,.,^?""A^3:=MAPTOCOMMAND(CH)5  (♦  TAKES  CH  AND  MAPS  IT  TO  A  COMMAND  *) 
1 1  o  E  N  D  » 

132 

1  PROCEDURE  GETLEADING; 
0  BEGIN 

0   (*  sets: 

0  LINESTART  A  POINTER  TO  THE  BEGINNING  OF  THE  LINE 

0  STUFFSTART  A  POINTER  TO  THE  BEGINNING  OF  THE  TEXT  ON  THE  LINE 

^  3YTES  THE  NUMBER  OF  BYTES  BETWEEN  LINESTART  AND 


2H1 


3323 

24 

:o 

0 

53^4 

24 

:3 

3 

3325 

24 

;i 

G 

3326 

24 

;i 

3 

3327 

24 

;i 

15 

3328 

24 

:i 

32 

3329 

24 

:i 

41 

3330 

24 

;o 

42 

3331 

24 

:o 

58 

3332 

25 

;o 

3 

3333 

25 

10 

0 

SSS^ 

25 

;i 

0 

3335 

25 

12 

12 

3336 

25 

;3 

12 

3337 

25 

:3 

15 

3338 

25! 

•3 

95 

3339 

25! 

13 

97 

3340 

25; 

,2 

117 

33m 

25- 

.1 

117 

3342 

25 

;2 

119 

3343 

25 

:2 

119 

3344 

25 

13 

119 

3345 

25 

;3 

130 

3346 

25 

13 

140 

3347 

25 

:3 

156 

3348 

25 

12 

156 

3349 

25 

:o 

159 

3350 

25 

!Q 

172 

3351 

25 

;o 

172 

3352 

26 

:d 

1 

3353 

26 

:d 

5 

3354 

26 

:d 

5 

3355 

26 

ID 

5 

3356 

26 

;d 

7 

3357 

26 

;o 

0 

3358 

26 

0 

3359 

26: 

X 

5 

3360 

261 

X 

11 

3361 

26; 

24 

3362 

26; 

41 

3363 

•'.6: 

50 

STUFFSTART 

BLANKS  THE  INDENTATlOINi  OF  THE  LINE     *) 

LirJCSTART:=CUR30R; 

IF  E3UF^CLINESTART3=CHR(E0L)  THEN  LINESTART : =LINESTART-1 !  (*  FOR  SCAN!  *) 
LlNESTART:=SCAr\l(-MAXCHAR,=CHR(EOL),EBUF'*CLINESTART:)+HNESTART  +  l; 
BLANKS :=LEADBLANKS(LiNESTART.3YTES) ; 
STUFFSTART :=L I NEST ART+BYTES 
END  (*  GETLEADING  *) ; 

FUNCTION  OKTODEL  (*  ( CURSOR . ANCHOR :  PTRTYPE ): BOOLEAN  *)  ; 
BEGIN 

IF  ABS{CURSOR-ANCHOR)>(BUFSIZE-BUFCOUNT)+10  THEN 
BEGIN 
MS5:  = 
•THERE  IS  NO  ROOM  TO  COPY  THE  DELETION.   DO  YOU  WISH  TO  DELETE  ANYWAY?  (Y/N)«; 

PUTMSG; 

IF  UCLC(GETCH)=«Y'  THEN  OKTODEL:=TRUE  ELSE  0KT0DEL:=FALSE; 

END 
ELSE 
BEGIN 

(*  copyline  is  set  by  the  caller  *) 

copyok:=true;  copylength:=abs(CURsor-anchor) ; 

copystart:=bufsize-copylength+i; 

moveleft(ebuf^cm in  {  cursor  »  anchor)  3,  ebuf'^ccopystart  3 ♦  cop ylength)  j 

oktodel:=true 
end; 
end; 

procedure  LINE0UT{*VAR  PTR:PTRTYPE;  BYTEStBLANKS,LINE:INTEGER*) ; 

(*  WRITE  A  LINE  OUT  *) 

VAR 

LINEDlSTfEOLDIST:  INTEGER; 

T:  PACKED  ARRAY  C0,,MAXSWa  OF  CHAR; 
BEGIN 

GO-TOXY(BLANKS.LINE)  ; 

PTRrrPTR+BYTES; 

eoldist:=scan(maxchar»=chr(eol)  .ebuf'^cptri)  ; 

LINEDlST:=MAX(0tMlN(EOLDIST,SCREENWlDTH-BLANKS+l)) ; 

W!OVELEFT{EaUF'^[:PTR:,l[:0D.LINEDIST)  ; 

IF  EBUF'^CPTR  +  LINEDISTJOCHR'  'D  THEN  (*  LINE  TRUNCATION  *) 


l^^^          1  26:2  bj  3EGI;. 

ii'^l          }  ?°-^  ^'-^  Ll.JLOlST:=MAX(Lir^E:DIST,l); 

^^ob   1  281-6  ^a  ti:linedist-i:];  =  '!»; 

3367  1  26:2  75  End; 

3368  1  26:i  75    ^RI  TE  <  T  :  LIfJEDlST  )  ; 
3J69    1  26:i  85    PTR : =Ptr+E0LDIST+1 

3370  1  2&:o  90  CNu; 

3371  1  26:o  106 

3373  1^  il:^  }    PROCEDURE  UPSCREEN  (  *FlRSTLirJE ,  WHOLESCREEN  :  BOOLEAN;  LINE:  INTEGER*); 

3374  i  27  n  1    '*    rtr'J'^fl^'    '''°    °^^^'^    ^^'"'-  '^'^    PROCEDURE  TO  UPDATE   pJsSIBLYpiRTlALLY) 

3375  1  27^^  a     Ir^  o^^rr^'*   "RSTLINE  MEANS  ONLY  THE  LINE  THAT  THE  CURSOR  IS  ON  NEED 

3376  1  ll''.  1            tl    UPDATED.   WHOLESCREEN  MEANS  THAT  EVERYTHING  MUST  BE  UPDATED.   IF 

3377^  i  2%^-o^  :   ',',rziz  iruki'rd'f^ ''''  °^^^  ^^^  '^'^  °^  ^^^  ^^-^^  '^^°'^  ^^^^ 

3378  1  27:D  4  vAR 

3379  1  27:d  4   ptr:  ptrtype; 

3380  1  27:D  5 

3381  1  27:o  0  BEGIN  (*  UPSCREEN  ♦) 

3382  1  27:i  0    IF  FIRSTLINE  THEN 

3383  1  27:2  3  BEGIN 

lilt  J  27:3  3      getleading; 

3386  J  ol'.l  .1                   GOT0XY(0,LINE)5  ERASETOEOL  { 0 ,  LINE)  ;  (*  CLEAN  THE  LINE  ♦) 

33^7  1  27;2  Is              ^^LINE0UT(LINESTART, BYTES, BLANKS. LINE)  (*  JUST  ThIs  LINE  i) 

3388  1  27:i  21    ELSE 

3389  1  27:2  23  IF  WHOLESCREEN  THEN 

^^91  1  olll  ^^                    CENTERCURSOR(TRASH, MIDDLE, TRUE) 

3392  1  27;3  37      ^^eg^N  ^"^""^  ^^^'"""^  ^""^  ^'^^  °^  ^^^  ^"^^^  ^''^^  ^"^  ^^^^OR  *) 

3394  J  ll'-l  fl          GOTOXY(0,LINE);  ERASEOS  ( 0  ,LINE)  ; 

nil  J"  SI*^  ^^                  setleading; 

mi  J  27:4  48                 ptr:=linestart; 

3396  1  27:4  51          REPEAT 

3398  1  IV'l  ^i  3LANKS:=MIN(LEADBLANKS(PTR,BYTES).SCREENWIDTH)5 

3399  I  2715  7I  |-INEOUT  (PTR , BYTES. BLANKS,  LINE )  ;  (♦  WRITES  OUT  THE  LINE  AT  PTR  *) 

340?  I  ^'A  II                      .^"^^^^  (LINE>SCREENHEIGHT)  OR  ( PTR>=BUFCOUNT) 

"^  "-^  X  t  f  .  o  00        END; 

3402  1  27:0  86  end; 

3403  1  27:0  100 

3404  1  28:d  1  PROCEDURE  READJUST( *cURSOR : PTRTYPE ;  DELTA:  INTEGER*);                       285 


3403 

■dBlu 

3 

3'+06 

28:0 

3 

3*^07 

28:  J 

3 

3408 

28:o 

i 

i'+og 

28:o 

0 

StlO 

28:i 

0 

S^fll 

28:2 

0 

3412 

28:3 

15 

3*tl3 

28:4 

27 

3*fm 

28:5 

33 

3415 

23:6 

33 

3416 

28:5 

59 

3417 

28  :i 

66 

3418 

26:2 

79 

3419 

28:o 

92 

3420 

28:0 

106 

3421 

29:d 

1 

3422 

29:d 

4 

3423 

29:D 

4 

3424 

29:d 

4 

3425 

29:d 

4 

3426 

29:d 

4 

3427 

29:d 

4 

3428 

29:d 

4 

3429 

29:d 

4 

3430 

29:d 

4 

3431 

29:d 

7 

3432 

29:d 

9 

3433 

29:o 

0 

3434 

29:i 

0 

3435 

29:2 

0 

3436 

29:3 

0 

3437 

29:3 

3 

3438 

29:3 

6 

3439 

29:3 

8 

3440 

29:3 

25 

3441 

29:4 

28 

3442 

29:5 

28 

3443 

29:6 

28 

3444 

29:6 

33 

3445 

79:5 

33 

ALL  AFFECTED 
DELTA  *) 


{*  IF  delta<o  then  ^o\Jt. 

MARKERS  >=  CJRSOR  BY 
VAR 

i:  INTEGER; 
BEGIN 

WITH  PflGEZERO  DO 

FOR  i:=0  TO  COUNT-1  DO 
IF  PAGENCI3=-1  THEN 

IF  POFFSETCn>  =  CURSOR  THEN 
BEGIN 

POFFSETClD:=MAX{POFFSETCn+DELTA,CURSOR); 
END; 
IF  (C0PySTART>=CURS0R)  AND  ( COPYSTARTCBUFCOUNT )  THEN 
C0PYSTART:=MAX{C0PYSTART+DELTA» CURSOR) ; 


BARKERS  TO  CURSOR.   ALSO  ADJUST  ALL 


end; 

PROCEDURE  THEFIXER(*PARAPTR:PTRTYPE;RFAC: INTEGER; whole: BOOLEAN*) ; 

(*  PARAPTR  POINTS  SOMEWHERE  IN  A  PARAGRAPH.   IF  WHOLE  IS  TRUE  THEN  THE 

ENTIRE  PARAGRAPH  IS  FILLED,  OTHERWISE  ONLY  THAT  DIRECTLY  AFTER  THE  CURSOR 
IS  FILLED.   RFAC,  WHEN  IMPLE^IENTED  WILL  TELL  HOW  MANY  PARAGRAPHS  TO  BE 
FILLED.   note:  A  PARAGRAPH  IS  DEFINED  AS  LINES  OF  TEXT  DELIMITED  BY  A  LINE 
WITH  NO  TEXT  ON  IT  WHATSOEVER,  OR  A  LINE  OF  A  TEXT  WHOSE  FIRST  CHARACTER  IS 
RUNOFFCH  ♦) 

VAR 

SAVEfPTRtWPTR:  INTEGER; 

WLENGTh.X:  INTEGER; 

DONE:  BOOLEAN; 
BEGIN 

WITH  PAGEZERO  DO 
BEGIN 

save:=cursor; 

cursor:=paraptr; 

getleading; 

if  ebuf^cstuffstart3  in  cchr ( eol ), runoffch]  then  exit ( thefixer ) » 

if  whole  then  (♦  scan  backwards  for  the  beginning  of  the  paragraph  *) 

^EGIN 
REPEAT 

cursor:=linestart-i; 

getleading 

UNTIL  (LlNESTART<=ir  "R  ( EBUF^CSTUFFSTART]  IN  CRUNOFFCH , CHRlEC   1); 


3'+46 

29:5 

52 

i^^l 

29:b 

65 

34f8 

29:5 

66 

S'+'+g 

29:6 

72 

iH^Q 

29:5 

75 

3451 

29:4 

60 

s^+sa 

29:3 

GO 

3*153 

29:4 

82 

S'+S't 

29:5 

62 

3455 

29:5 

85 

3456 

29:4 

99 

3457 

29:3 

104 

3458 

29:3 

113 

3459 

29:3 

122 

3460 

29:3 

122 

3461 

29:3 

126 

3462 

29:3 

134 

3463 

29:3 

139 

3464 

29:3 

145 

3465 

29:3 

148 

3466 

29:tf 

148 

3467 

29:5 

162 

3468 

29:4 

183 

3469 

29:4 

186 

3470 

29:4 

166 

3471 

29:4 

213 

3472 

29:4 

213 

3473 

29:4 

234 

3474 

29:5 

254 

3475 

29:4 

274 

3476 

29:4 

281 

3477 

29:5 

302 

3478 

29:& 

302 

3479 

29:6 

316 

3460 

29:6 

326 

3481 

29:6 

336 

3482 

29:6 

341 

3483 

29:5 

341 

3484 

29:if 

346 

3465 

29:4 

351 

3486 

29:4 

358 

KJ  CRUNOFFCH,CHR(EOL)D  THEN 


THEN  X:=PARAMARGIN  ELSE  X:=LMARGIN 


♦  ) 


if  fibuf'^cstuffstartj 
ptr:=cur.sor+i 

ELSE 

ptr:=i; 
x:=paramargin; 

END 
ELSE 
BEGIN 

ptr:=linestart; 
if  blanks=paramargin 
end; 

cursor:=bufsi2e-(bufcount-ptr)+i;  (*  split  the  buffer 

MOVeRIGHT(EBUF'^CPTR:,EBUF'^C  CURSOR  3,  BUFCOUNT-PTR); 
(*  NOW  DRIBBLE  BACK  THE  (REST  OF  THE)  PARAGRAPH  *) 
EBUF'"CPTR3:=CHR(DLE); 
EBUF'*CPTR  +  1D:=CHR(X+32)  ; 

ptr:=ptr+2; 

EBUF"CCURS0R-13:=CHR(E0L)5  (♦  SENTINEL  FOR  GETLEADING  *) 

done:=false; 

REPEAT 

WHILE  ebuf^ccursord  In  cchr{ht)»chr{sp).chr(dlE)3  do 

.,nJp.5rnocno^'^^°^^^^^'^^°'-^'  ^^^^    CURSOR :  =CURS0R+2  ELSE  CURSOR  I  sCURSOR  +  X  ; 
(*  SKIP  OVER  A  TOKEN  *) 

WHILE  NOT  (EBUF-CCURSORD  IN  CCHR(EOL),»  •»•-•:)  DO  CURSOR:=CURSOR+l ; 
(*  SPECIAL  CASES  FOR  ".<SP><SP>"  AND  "-<SP>"  *)     ^   *"  •  ^'U'^auK  +  l, 

IF  E3UF-CCURsORD=»-»  THEN  IF  EBUF^CCURSOR+l 3=»  ♦  THEN  CURSOR:=CURSOR+l 5 
IF  (EBUF'^CCURSOR-i:  In  C  ..  i  ,  1 7.  ,,,,,,„»  3,  JHEN  IF  uuncur^-M, 

(EBUF-CCURS0R3=»  •)  AND  ( EBUF-CCURS0R+13=»  •)  THEN  CURS0R:=CURS0R+1 ; 

<     (*  INCLUDING  THE  DELIMITER  ♦) 
OR  (RMARGlN-LMARGlN+KsWLENGTH)  THEN 


WLEN6TH:=CURsOR-WPTR+1 
IF  {X+WLENGTH>RMARGIN) 
BEGIN 

IF    EBUF-CPTR-1D=»     •    THEN   PTR:=PTR-i; 

ebuf"Cptrd:=chR(eol)  ;  ebuf'^cptr+id:=chr(dlE)  ; 

ebuf'"cptr  +  23:rchr(lmar6in+32)  ; 

ptr:=ptr+3; 

x:=lmargin 
end; 
cursor:=cursor+i; 

MOVELEFTCESUF'^CWPTRD.EBUF'^CPTRJ.WLENGTH); 

IF  E3Uf^ccursgr-i:=chr(eol)  then 
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1    29:5 

367 

1    29:6 

iD7 

1    29:6 

374 

1    29:7 

379 

1   29:d 

379 

1   29:a 

331 

1    29:8 

386 

1   29:c 

396 

1    29:8 

396 

1    29:8 

396 

1    29:9 

400 

1    29:0 

400 

1   29:o 

408 

1   29:o 

408 

1    29:9 

422 

1    29:7 

422 

1    29:5 

422 

1   29:4 

422 

1   29:** 

427 

1    29:3 

432 

1    29:3 

435 

1    29:3 

447 

1    29:3 

456 

1    29:3 

467 

1    29:3 

471 

1    29:3 

481 

1    29:3 

483 

1    29:2 

435 

1    29:o 

491 

1   29:o 

512 

1   3o:d 

1 

1   3o:d 

44 

1   3o:d 

44 

1   3o:d 

45 

1   3o:o 

0 

1   3o:i 

0 

1   30  :i 

47 

1   3o:i 

62 

1   3o:i 

100 

1   3o:i 

116 

1   "^0:0 

135 

IF    E3UF^i:CJRSOR3  =  CHR(0)     THEN    DONE:=TRUE 
-LSE 
BEGIN 

GETLEAUIf\l3; 

D0N£:  =  (EB'JF'*CSTJFFSTART3=CHR(E0L)  ) 

UR  (EBUF''CSTUFFSTART:=RUN0FFCH)  ! 
(*  THE  LAST  TRANSFER  WILL  MOVE 

OVER  THE  <EOL>  FOR  THE  PARAGRAPH  *) 
IF  MOT  DONE  THEM 
BEGIN 

EBUF'^CPTR  +  WLENGTH-ia:  =  »  •; 

(*  IF  <EOL>  <SP>i  MAP  TO  ONE  SPACE  ONLY  ♦) 
IF  EBUF'^[:cURS0R-2:=»  •  THEN  PTR:=PTR-l; 
END 
END 

end; 

x:=x+wlength; 

ptr:=ptr+wlength; 
UNTIL  done; 

REaDJUST(PARAPTR»  <bufsize-cursor+ptr  +  i>-bufcount) ; 
bufcount:=bufsize-cursor+ptr+i; 

M0VELEFT(EBUF^C cursor DtEBUF'^CPTR 3. bufsize-cursor  +  1)  ; 
ebuf''cbufcount3:=chr(o)  ; 
cursor:=min(Bufcount-i»save)  ; 
getleading; 

cursor :=MAX( cursor, STUFFSTART) 

END; 

end; 

PROCEDURE  getname(*msg:string;  var  m:name*); 

VAR 

i:  integer; 
s:  string; 
begin 
neeoprompt:=true;  home;  clearline(O) ;  writecmsgi'  what  marker?  m 

readlN(s) ; 

FOR  i:=i  TO  length{S)  do  sc:n:=ucLC(SCiD) ; 

moveleft(sci:»mco:,min(8»length(S) ) ) ; 

FILLCHaR(MCLENGTH{S)3»MAX(0,8-LENGTH(S) ),♦  •) 

end; 


3528  1  30 :o  150 

3529  1  30:0  150 

^^^?    1  36:D  1  i^RQCEDjRC  DISKERR; 

3551    1  36  :o  u  ::EGIW 

353^    ^  im  J          ERRORCBAD  DISK  TRANSFER  .♦,  MOMFATAL)  ; 

ooii    1  36:o  2*+  ENOi 

353^    1  3&:o  36 

nil       I  H\d  I   VAR^^^°''  writeit(*which:leftright):boolean*); 

nil  J  z^'°  '+  ^^^^'   boolean; 

3538  1  34:0  0  BEGIN 

nil  I  tuiJ  °    FULL:=(LPAGE+1>=RPaGE); 

^^u?  ^  ^^-^  ^^    ^^  f^O^  FULL  THEN 

3541  1  34:2  15      BEGIN 

3543  t  11:1  J^        ^'^  WHICH=LEFTSTACK  THEN 

5543  1  34:4  20          BEGIN 

nil  J  34:5  20            LPA6E:=LPA6En; 

3546  1  34;4  53  rJo^   BLOCKWRlTL(  THEFILE,PAGEBUFFER,  2,LPAGE+LPAGE)<>2  THEN  DISKERR 

3547  1  34:3  55  fLsE 

3548  1  34:4  57  SEGIN 

3550  I  11:1  ^"^         RPage:=rpage-i; 

3551  1  34;4  90  r.^  ^^^^''^^^^'^"^"'-E.PAGEBUFFER  .2  .RPAGE+RPAGE)<>2  THEN  DISKERR 

3552  1  34:2  92  END; 

nil  i  ^-^  ^2      writeit:=not  full 

3554  1  34:o  92  END; 

3555  1  34:o  108 

3557  I  33:°  I    vAr'^^^°'^  READITCWHICH.-LEFTRIGHT):  BOOLEAN*); 

^^^o  I  IV°  **   tapcity:  boolean; 

3559  1  33:0  0  BEGIN 

356?  I  If: J  °    TAPClTy:=((WHICH=LEFTSTACK)  AND  (LPA6E<=0))  OR 

3562  i  33';i  23    IF  NOT  TAPCn^'THEN''"'''''' '  ''°  (RPAGE>=FLENgTH)  ,  ; 

3563  1  33:2  27  BEGI.M 

356S  ]  IV.a  \l                    ^^    WHICH=LEFTSTACK    THEN 

03&5  1  33:4  32                         BEGIN 

356?  i  3315  II                              J^    BJ:?CKREAD(THEFILE,PAGE8UFFER,2.LPAGE.LPAGE)<>2    THEN    DISKERR, 
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69 
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96 
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99 

357*1 

33:2 

104 
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33:i 

104 

3576 
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108 

3577 

33:o 

120 

3578 

3i:d 

1 

3579 

31  :d 

2 

3580 

3i:d 

2 

3581 

3i:d 

2 

3582 

3i:d 

2 
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3i:d 

7 

3584 

3i:o 

0 

3585 
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0 
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3i:i 

11 

3587 

3i:i 

14 

3588 

31:2 

19 

3589 

31:3 

19 

3590 

31:3 

22 

3591 

3i:4 

33 

3592 

3115 

33 

3593 

31:5 

40 

359*1 

3116 

43 

3595 

3i:7 

43 

3596 

3i:7 

64 

3597 

3i:7 

73 

3598 

3i:8 

73 

3599 

3i:9 

88 

3600 

3i:o 

103 

3601 

3i:i 

103 

3602 

3i:i 

112 

3603 

3i:o 

123 

360'+ 

3i;7 

135 

3605 

31:7 

140 

3606 

3i:6 

i^e 

3607 

3i:4 

14d 

3603 

31: 3 

150 

5609 

^i:3 

ItsS 

290 


else: 

3EGIN 

IF  BL0CKREAD(THEFILE.PAGEBUFFER,2iRPAGE+RPAGE)<>2  THEN  DISKERR; 

rpage:=rpage+i 

END 
END! 
READlT:=fMOT  TAPCITY? 
ENO; 

PROCEDURE  GETPAGES(*WHICH:LEFTRIGHT*) 5 

(*WHICH  IS  WHICH  STACK  YOU  WANT  TO  READ  FROM,   STOPPING  CONDITION:  APPROXIMATELY 
2000  CHARACTERS  OF  SLOP  LEFT  IN  THE  BUFFER  OR  NO  MORE  STUFF  TO  READ  *) 

VAR 

it  start, stuffcountftherest.notnulls:  integer; 
notdone:  boolean; 

BEGIN 

IF  COPysTART>BUFCOUNT  THEN  COPYOK:=FALSE;  {*  TRASH  COPY  BUFFER  ♦) 

N0Ta0NE:=TRUE; 

IF  WHICH=RIGHTSTACK  THEN 

BEGIN 

start:=bufcount; 

while  (start<aufsize-3000)  and  notdone  do 

BEGIN 

notdone:=readit(Which) ; 
IF  notdone  then 

BEGIN 

NOTNULLS:=SCAN(-1024»<>CHR{0)iPAGEBUFFERCl023  3)+1024; 
MOVELEFTCPAGEBUFFERtESUF^CSTARTDiNOTNULLS); 
WITH  PAGEZERO  DO  (*  SWAP  IN  MARKERS  *) 
FOR  i:=0  TO  COUNT-!  DO 

IF  PAGENCI3=RPAGE-1  THEN 
BEGIN 

PAGENcn:=-i; 

POFFSETL I  2 1 =POFFSETC I 3+START I 
END; 

START :=start+notnulls; 

WRITE( •,»  ) 

END 

END; 

bufcount:=start; 
ebjf"C3Ufcount::=chr{0)/ 


361U  i  31  :^  i-j7 


LfJU 


^°11         1  3i:i  157         t_L3£; 

i6l2    1    3l:2    169      SEGI.^J  (*  LEFTSTACK  *) 


361J    1    31:3    159 


THtREST:=dUFSl2E-BUFC0UNT+l 


3614  1  3i:3  166  start:=therest-i; 

t't'  t  ^1^*^  ^'^^  READJUSTd, START); 

3617  1  A'-l  \ll  '^0^^RISHT(E3UF'^Cia,EBUF-CTHERESTD»BUFC0UNT); 

^^iA  \  z.'.r  ^  ^"^^^^  (START>  =  3000)  AND  NOTDONE  DO 

3D1S  1  3i:4  191  BEGIN 

nil  \  IWl  11^  'Motdone:=readit(which); 

Vli^  1  ^'^  ^^^  I""  NOTDONE  THEN 

ob<^l  1  3i:6  2U1  3EGIN 

3.2.  X  3i:7  ill  lV.im\ZfZVmlll^^^^^ 

3626  1  IV'l  III  ^^^^    PAGEZERO  DO  (*  SWAP  IN  MARKERS  *) 

3627  1  IV'l  III  ^^^    ^-=0  T°  COUNT-1  DO 

^°'=-l  1  31.9  255  Tr  DACIr^,r  T  T_i  r,«<-r-  .  ,   , 


3628  I         a'llo    270  '^^^f^^^  "=^^^^^*^  ^^^^ 

3629  1    3l:l    270  PAGENCIi'-i 

3630  1  3i:i  279  pp^^l^EL^:::^ 

END; 


3629         1         31 :l         270  ^    pJgL 

363?         1         WW         IVr  __POFFSETEn:=POFFSETCn+START  +  l; 


nil  \  IWl  304                                       WRITEC.M; 

3633  1  3i:6  312  rwn 

3634  1  3i:4  312  END; 

\l\^^  \  iV'\  ^^"^              stuffcount:=bufsi2E-start; 

3637  1  V;:l  l^^              cursor:=cursor+stuffcount-bufcount; 

VAl  .  l^'  ^^°                    READJUSTd, -START); 

^'^Q  J  l^'^  ^^^              bufcount:=stuffcount; 

3640  I  Wli  III  ^^M0vELEFT(EBUF'^CSTART  +  13,E3UF-C1:1.STUFFC0UNT); 

3641  1  3i:i  343    EBUF^C  3UFC0UNT:1  :  =CHR  (  0  )  ; 
3o42  1  3i:f)  3^7  ^f^Q. 

3643  1  31:0  372 

3645  }  f?:?      ^  PROCEDURE  PUTPAGES(*wHICH;LEFTRIGHT*); 

3646  i  32:0      2  '*    RlGH?'s?Acf  *T'  ''"'  ''''  '''  '°  ''"  ^^''    ''''*"    OTHERWISE  SWAP  OUT  TO  THE 

3647  1  32:0      2  VAR 

3649  ^  IV-?  o    ^♦ST0P,\1ARK, SAVE. ONEPAGE,PTR, last:  INTEGER; 

^cKn  :  ,  *^    ^  °^'   boolean; 

3650  1  32:0      9  oqi 


or 


l'^ 


3651 
3652 
3653 
365'+ 
3655 
3656 
3657 
365d 
3659 
3660 
3661 
3662 
3663 
366'+ 
3665 
3666 
3667 
3668 
3669 
3670 
3671 
3672 
3673 
3674 
3675 
3676 
3677 
3673 
3679 

36eo 

3681 
3682 
3683 
3684 
3685 
3686 
3687 
3688 
3689 
3690 
3691 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


37:D  3  FUNCTION  MOVCITO JT ( STAKT , STOP : I MTEGER ) :  BOOLEAN; 

37:d  5  vAR  I:    lmteglR; 

37:0  0  BEGIN 

37:i  0  IF  stop>=start  then 

37:2  5  BEGIN 

37:3  5  M0VELEFT(E3UF-[:SrART3,PAGEBUFFER»ST0P-START  +  l); 

37:?  18  FILLCHAR(PAGEBUFFERCSTOP-START+1].1023-(STOP-START) »CHR(0) ); 

olio  36  v|0\/EITOUT:=WRITEIT(WHICH)  ; 

37:3  45  '^ITH  PAGEZERO  00  (*  SWAP  OUT  MARKERS  *) 

37:4  45  FOR  i:=0  TO  cOUNT-1  DO 

37:5  60  IF  (PAGENCI3=-1)  AND  (POFFSETC n>=START )  AND  ( P0FFSETCI3<=ST0P)  THEN 

37:6  92  BEGIN 

37:7  92  IF  WHICH=LEFTSTACK  THEN  PAGENC I d:=LPAGE 

37:7  105  else  pagenc i d:=rpage ; 

37:7  121  poffseteid:=poffset[:i3-start; 

37:6  137  end; 

37:3  144  WRITEC.') 

37:2  152  END 

37:1  152  ELSE 

37:2  154  moveitout;=false 

37:o  154  end; 

37:0  174 

32:0  0  BEGIN  (*  PUTPAGES  *) 

32:i  0  if  WHICH=LEFTSTACK  THEN 

32:2  5  BEGIN 

32:3  5  LAST:=MAX(CURSOR-200.1) !  (*  SLOP  IS  200  *) 

32:3  17  PTR:=i; 

32:3  20  REPEAT 

32:4  20  one:page:=min(PTr+io22,last)  ; 

52:4  32  stOPMARK:=SCAN(-MAXCHAR.=CHR(EOL) ,EBUF"C0NEPAGE3)+0NEPAGE; 

32:4  47  IF  PTR  <  STOpMARK  THEN 

32:5  52  BEGIN 

32:6  52  OK:=MOVElTOUT(PTRtSTOPMARK) ; 

32:6  60  if  ok  then 

32:7  63  ptr:=stopmark+i 

32:6  64  ELSE 

32:7  70  ERR0R(»RAN  OUT  OF  DISK  ROOM' . NONFATAL ) ; 

32:5  96  END 

32:4  96  ELSE 

32:5  98  ok:=false; 

32:3  101  UNTIL  NOT  OK  OR  (ONEPAGE   AST); 


3692 
5S)5 
369tf 

3696 

3697 

3698 

3699 

3700 

3701 

3702 

3703 

3701 

370b 

3706 

37U7 

3708 

3709 

3710 

3711 

3712 

3713 

371<+ 

3715 

3716 

3717 

3718 

3719 

3720 

3721 

3722 

3723 

3724 

3725 

3726 

3727 

3728 

3729 

3730 

3731 

3732 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
1 
i 
1 


52; 
32; 
32: 
32; 
32: 


32:3 
32:3 
32:3 
32:3 
32:3 
32:3 

32:4 

32:5 
32:6 
32:7 
32:6 
32:3 
32:2 

32:i 

32:2 
32:3 
32:3 
32:3 
32:3 
32:3 
32:3 

32:h 
32:4 

32:5 

32:4 

32:5 

32:4 

32:5 

32:6 

32:6 

32:7 

32:6 

32:7 

32:5 

32:4 

32:5 


1U9 

109 

116 

122 

143 

150 

159 

163 

163 

163 

163 

163 

178 

190 

190 

213 

220 

227 

227 

229 

229 

234 

237 

251 

253 

256 

256 

268 

273 

273 

278 

294 

299 

299 

307 

310 

311 

317 

343 

34  3 

345 


(*  PTR  rJOW  POIf.jTS  TO  THE:  FIRST  VALID  CHARACTER  IN  THE  BUFFER  *) 

if  copystart<f'tr  then  copyok :  =false 
else: 

IF  COPYOK  AND  ( CQPYSTART<3UFC0UNT )  THEN  COPYSTART: =C0PYSTART-PTR+1 5 
BUFC0UrvlT:=3UFC0UNT-PTR  +  i;  r  .  .  h,m   ,  r^-M , 

M0\/ELEFT(EBUF'*CPTRD,EBUF'*C1D,BUFC0UNT-1)  ; 
EBuF*C3UFCOUNTd:=CHR(0) ; 

(*  NOlfll  SHIFT  OVER  THE  MARKERS  THAT  ARE  STILL  IN  - 
NOTE  THAT  READJUST  CAN'T  BE  USED  HERE  BECAUSE  THE 
MARKERS  WANT  TO  GET  SHIFTED  PAST  PTR  *) 
WITH  PAGE2ER0  DO 

FOR  i:=0  TO  COUNT-1  DO 
IF  PAGENCI3=-1  THEN 
BEGIN 

POFFSETi:n:=MAX(ltPOFFSETCn-PTR  +  l); 
END; 
CURSOR :=CURSOR-PTR+i; 

END 
ELSE 

begin  (*  right  *) 
ptr:=bufcount-i; 
sa\/e:=cursor; 

CURSOR :=MIN{CURSOR+200»BUFCOUNT-1)  ; 
GEtlEADING! 

last:=linestart; 
repeat 

ONEPAGE:=MAX(PTR-1022»LAST) ; 
IF  0NEPAGE=LAST  THEN 

ST0PMARK:=0NtPAGE 
ELSE 

STQPMARK:=sCAN(MAXCHAR.=CHR(E0L)»EBUF'^C0NEPAGED)+0NEPAGE+1; 
IF  STOPNIARK  <  PTR  THEN 

BEGIN 

qk:=moveitout(Stopmark.ptr) ; 
if  ok  then 
ptr:=stopmark-i 

ELSE 

ERR0R{»RAN  out  of  disk  ROOM'iNONFATAL) ; 

END 
ELSE 

ok:=false;  c 


?93 


•9^ 


67-66 

32:3 

346 

3734 

32:3 

356 

3735 

32:3 

365 

3736 

32:5 

332 

3737 

32:5 

335 

3758 

32:3 

389 

3739 

32:2 

393 

57'+0 

32:o 

399 

^741 

32  :o 

422 

3742 

35:d 

1 

37'+5 

35:d 

2 

37'f'+ 

35:d 

2 

3745 

35:d 

2 

3746 

35:0 

0 

3747 

35:i 

0 

3748 

35:i 

2 

3749 

35:2 

9 

3750 

35:3 

9 

3751 

35:3 

20 

3752 

35:3 

28 

3753 

35:3 

38 

3754 

35:3 

47 

3755 

35:3 

51 

3756 

35:2 

58 

3757 

35:o 

59 

3758 

35  :o 

72 

3759 

35:o 

72 

3760 

35:o 

72 

3761 

i:o 

0 

3762 

i:i 

0 

3763 

i:i 

39 

3764 

1:2 

39 

3765 

1:2 

50 

3766 

1:2 

54 

3767 

1:2 

64 

3768 

1:3 

64 

3769 

1:3 

69 

^770 

1:3 

72 

3771 

1:3 

77 

3772 

1:2 

87 

3773 

1:1 

95 

UNTIL  (0:^EPA3c:=LAST)  OR  NOT  OK; 
COpyOK:=(COPYOk  and  {C0PYSTART>BUFC0UNT) )  OR 

(copyak  and  (copystart+copylength<last) ) 
bufcou;jt:=last; 

EB  JF"Cc3UFCOUNTj:=CHR(0)  ; 
CURSOR :=MIN(BUFC0UNT-1. SAVE) 

END 


END: 


PROCEDURE  CHECKINDENT(*VAR  CURSOR : PTRTYPE* ) ; 

(*  CHECK  TO  >^AK£  SURE  THAT  THE  LINE  POINTED  TO  BY  CURSOR  HAS  A  LEGITIMATE 
(ACCORDING  TO  THE  COMPILER.  I.E.  ONLY  ONE  DLE)  INDENTATION  PART.   IF  NOT 
THEN  MAKE  IT  SO  ♦) 
BEGIN 

SETLEADING; 

IF  STUFFSTART-LINESTART>2  THEM  (*  POTENTIALLY  TROUBLE!  *) 
BEGIN 

MOVELEFT(EBUF'^CSTUFFSTART:iEBUF'^CLINESTART+2  3,BUFCOUNT-STUFFSTART); 

REaDJUST(LINESTART,LINESTART+2-STUFFSTART)5 

CURSOR :=CURSOR+H NEST ART+2-STUFFSTART; 

bufcount:=bufcount+linestart+2-stuffstart; 

EBjf'*CLINESTART]:=CHR(DLE)  ; 
E8UF'^CLINESTART  +  1::=CHR{BLANKS  +  32) 

end; 
end; 

(*$TE  D  I  T  0  R*) 

BEGIN  (*  SEGMENT  PROCEDURE  EDITOR  *) 

INITIALIZE;  GETLEADING;  CURSOR :=MAX{CURSOR.STUFFSTART) ; 
REPEAT 

CEnTeRCURSOR(TRASH.(SCREENHEIGHT  DIV  2)+l»TRUE); 

needprompt:=true; 

if  userinfo.errblk>0  then  putsyntax; 

REPEAT 

hOivie;   clearline(O)  ; 
editcore; 

if  c0m/«iand  =  setc  then  environment 
else  if  command=copyc  then  copyfile 
until  commano=qultc; 
UNTIL  out; 


5775 
377i 
5  777 


1:1 
1:0 
1:0 

1 : 0 


102         SYSCO^-.viISCIf-JFG.rJoBKEAK 

109  end; 

142 

0    3EGIN    ENl). 


=    FALSE       (♦    28    SEPT    77*) 


295 


2 
3 

5 

r 
O 

7 

a 

9 

ij 
11 

12 
13 

m 

15 

16 

17 

18 

19 

2Q 

21 

22 

23 

2*+ 

25 

26 

27 

2fi 

29 

30 

31 

32 

33 

i^ 

35 

3o 

37 

38 

39 

'to 


1 
1 
1 
1 
i 
1 
1 
1 
1 
1 
1 
1 
1 
0 
0 
0 
0 
0 
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Q 
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0 


0 

a 

a 

0 

0 
0 

J 
a 

0 

u 

(■> 
0 

:) 
J 
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1 

1 

X 

l: 

1 

1 

1 

1 

1: 

1; 

1 

l; 

1 

1 

1 

1 

1 

1 

1 

1 

1 

l: 

1 

1 

1 

1 

1 

1: 

1 

1 

1 

1 

1 

1 

1 

1: 

1 

1 

1 


u 
■J 
D 

u 

J 

U 

D 


0 
D 
D 
D 
u 
D 

D 

n 
<j 

D 

0 

0 

0 

0 

D 

J 

D 

D 

0 

u 

D 

D 
D 
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u 
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1 
1 
1 

1 
i 

X 

i 
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X 

1 

1 

1 

1 

i 

1 

1 

1 

1 
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{♦SI  GLOJALS.TlXT*) 

{ *$U-*) 

(*$S+*) 

(*****  + ♦:**  +  *;Hc**)t:t****  *♦*********♦********♦*****♦********♦♦*♦******) 
(*  ♦) 

(♦  COPYRIGHT  (C)  1973  REGE'MTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.  *) 

{*  ^EKMISSION  TO  COPY  OK  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-  *) 

(*  TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE  *) 

(*  OaTAINEO  FROfW  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS.  *) 

(*  *) 

PROGRAM  PASCaLSYSTEM; 


UCSD  PASCAL  OPERATING  SYSTEM 


RELEASE  LEVEL:   1.3 

1.5 


AUGUST*  1977 
JANUARY,  1978 
SEPTEMBER,  1978 


*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*> 
*) 
♦) 
*) 
*) 
*) 
*) 


WRITTEN  BY  ROGER  T.  SUMNER 
WINTER  1977 

INSTITUTE  FOR  INFORMATION  SYSTEMS 
UC  SAN  DIEGO,  LA  JOLLA,  CA 


KENNETH  L.  BOwlES,  DIRECTOR 
CONST 


MMAXINT  =  32767; 
MAXJNIT  =  12; 
MAXDIR  =  77; 
VIOLENG  =  7; 
TIDlENG  =  15; 
MAX5ES  =  15; 
FoLKSlZE  =  512; 


(♦MAXIMUM  INTEGER  VALUE*) 

(♦MAXIMUM  PHYSICAL  UNIT  #  FOR  UREAD*) 

(♦MAX  NUMBER  OF  ENTRIES  IN  A  DIRECTORY*) 

(♦NUMBER  OF  CHARS  IN  A  VOLUME  ID*) 

(♦NUMBER  OF  CHARS  IN  TITLE  ID*) 

(♦MAX  CODE  SEGMENT  NUMBER*) 

(♦STANDARD  DISK  BLOCK  LENGTH*) 


397 


^^  -^  ^'-'  1                  JIKILK    =    2;                        (>kDiSK    AODR    OF    DIRECTORY*) 

^"^  ^^  -'■•'^  -^                  AGt^lMIT    =    oOO;             (*MAX    A3E    FOR    GDIRP..,IN    TICKS*) 

^l  !  ^-'-^  1                  tOL    =    13;                              (+END-OF-LINE.. .ASCII    CR*) 

■^^  ^  ^'^  -^                  CLE    =    16;                              (*BLAf\JK    COMPRESSION    CODE*) 

l^  '^  '■'^  1                  NAME.LE.M    =    23;               CLEiNjGTH    OF    CONCAT  (  VIDLENG »  '  :  •  ,  TIDLEIMG )  J 

^°  ^  ^'^j  i                  FILL.LLf^i    =    11;               C'MAXIMUM    u    OF    NULLS    IN    FILLER] 

'+7  0  i:D  1 

'+8  0  1:d  1  jYP£ 

^+9  u  i:o  1 

^?  '^  ^'"^  1       iorsltwd  =  (IN0eRR0R.I3ADBL0CK,IBA0UNIT,IBADM00E»ITIME0UT, 

:J  ':'  J*^  1                   ILOsTUNITtlLOSTFILEiIBADTITLEtlNOROOMf  INOUNIT, 

?f  ^  ^'^  1                   INOFILE,IOUPFILE.INOTCLOSED,INOTOPEN,IBADFORMAT, 

f-^  ^  l^"^  1                   ISTRGOVFL); 

54  0  i:d  1 

5^  Q  J:^  ^                                          {♦COMMAND  STATES. ..SEE  GETCMD*) 

^"7  "^  1'2  1       CMDSTATE  =  (  HAlTINIT,  DEBUGCALL, 

ll  ^  I'D  1                   UPRO&NOU,UPROGUOKtSYSPROG» 

^^  0  ^'^  1                   COMpONLY,COMPANDSOfCOMPDEBUG« 

^•^  0  11'^  1                   LiNKANDGOtLlNKDEBUG)  ! 

oi  0  i:d  1 

62  0  i:d  1 

63  D  113  1 

64  0  i:d  1 

65  0  i:d  1 

66  0  i:o  1 


29: 


(♦CODE  FILES  USED  IN  GETCMD*) 
SYSFILE  =  (ASSMBUER, COMPILER, EDITOR, FiLERiLlNKER) ; 

(♦ARCHIVAL  INFO,, .THE  DATE*) 


67  0  i:d  i 

°d  0  l:o  1  DATerEC  =  PACKED  RECORD 

7^  ^  J:^  ^                   month:  0..12;           (*0  IMPLIES  DATE  NOT  MEANINGFUL*) 

!.;  I  ^''^  i             3ay:  0..31;         (♦day  of  month*) 

!,l  :  t*'^  ^              year:  o,.ioo         (*ioo  is  temp  disk  flag*) 

^2  u  1:D  1                                             END    (*DATEREC*)     ; 

73  0  i:d  1 

It  i  }'^  ^                                                                                                             (*V0LUME    TABLES*) 

75  0  i:d  1  UNITimUM  =   o..maxunit; 

76  0  i:d  1  \/id  =  stringcvidlengj; 

77  0  1:0  1 

It  0  1:0  1                                          (*DISK  directories*) 

79  i)  1:Q  1  DIRraNGE  =  a..MAXDIR; 

Qo  0  i:d  1  Tio  =  stringctidlengd; 

^1  0  i:d  1  full_id  =:  stringcname-len:; 


62 

3 

i:D 

83 

0 

i:c 

6^ 

■J 

I'.u 

35 

0 

i:.D 

66 

0 

i:d 

87 

0 

i:c 

as 

0 

i:d 

39 

0 

i:d 

90 

0 

i:d 

31 

0 

i:d 

92 

0 

i:d 

93 

0 

i:o 

91 

0 

i:d 

95 

0 

i:q 

96 

0 

i:d 

97 

Q 

i:d 

98 

0 

i:d 

99 

0 

i:d 

100 

0 

i:d 

101 

0 

i:d 

102 

0 

i:o 

103 

0 

1:0 

104 

0 

i:d 

105 

0 

i:d 

106 

0 

i:d 

107 

0 

1:0 

108 

0 

i:d 

109 

0 

i:d 

110 

0 

i:d 

111 

0 

1:0 

112 

0 

i:d 

113 

0 

i:d 

lit 

0 
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FILl_TA3LE  =  AKRAY  CsrSFlLED  OF  FULL_ID! 

FILFKlND  =  (UNTYPEDFILtfXDSKFILEtCODEFlLE.TEXTFILEf 

INFOFILE, DAT AFlLEtGR AFFILE iFOTOFILE.SEcUREOXR) ; 


DIREIiMTRY  =  PACKED  RECORD 

dfirstblk:  hmteger; 
dlastblk:  inteser; 
case  dfkind:  filekind 

securedir, 

untypedfile:  (*only  in 

(FILLERl  :  0,.20H85 

dvid:  vid; 
deov8lk:  integer; 


(*first  physical  disk  ADDR*) 

(*POINTS  AT  BLOCK  FOLLOWING*) 
OF 


DIRCO3., .VOLUME  INFO*) 

CFOR  DOWNWARD  COMPATIBILITY* 13 
(♦NAME  OF  DISK  VOLUME*) 
(♦LASTBLK  OF  VOLUME*) 


BITS3 


dnumfiles:  dirrangel    (^num  files  in  dir*) 
dloadtime:  integer;     (*time  of  last  access*) 
dlastboot:  datereoj    (*most  recent  date  setting*) 

XDSKFILE,CODEFILEtTEXTFlLE»lNFOFILE, 

datafile»graffile.fotofile: 

(filler2  :  0.,512;  cfor  downward  compatibility^ 

status  :  BOOLEAN;         CFOR  FILER  WILDCARDS^ 

dtid:  tio;  (*title  of  file*) 

dlastbyte:  l.fblksize;   (*num  bytes  in  last  block*) 


END 


daccess: 

(*DIRENTRY*) 


DATEREC) 


(*LAST  modification  DATE*) 


DiRp  =  ^directory; 

DIRECTORY  =  ARRAY  CDIRRANGE]  OF  DIRENTRY; 

{♦FILE  INFORMATION*) 

CLOSETYPE  =  (CNORMAL.CLOCKfCPURGEiCCRUNCH); 
WINDOWP  =  '^WINDOW' 

WINDOW  =  PACKED  ARRAY  C 0 , . 0 3  OF  CHAR; 
Fl3p  =  *FIB; 

fib  =  record 

fwindow:  windowp;  (*user  window ..  .f** t  used  by  get-put*) 
feof.feoln:  boolean; 
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F  ST  ATE:     (hJAMDW.FrJEEOCHARfFGO 

frfcsize:  integer;  {*i\   3YTes 

CASE  FisOPEN:  EOOLEAN  OF 

TRUE:  (FIS5LKD:  30QLEAIM;  (* 

funit:  uiJiTf-JU;^!;  (* 
fvid:  vio;       (* 

FREPTCNTi  (* 

FrjXTBLK,  (* 

fmaxblk:  integer;  (* 
fnoqifiedisoolean; (* 
fheader:  direntry;(* 

CASE  FSOFTBUF:  BOOLE 

true:    (FnxtbytEifm 
f3ufchngd: 
!^3uffer:   pa 
i\iD   (*fi3*)    ; 


tchaR) ; 

...0=>BLQCKFILE» 


i=>charfile*) 


FILE  Is  ON  block  DEVICE*) 
PHYSICAL  UNIT  tt*) 

volume  na^e*) 

#  times  f*^  valid  w/0  get*) 
next  rel  block  to  10*) 
max  rel  block  accessed*) 
please  set  new  date  in  close*) 
copy  of  disk  dir  entry*) 
an  gf  (*disk  get-put  stuff*) 
axbyte:  integer; 
boolean; 
cked  array  c 0 , .fblksi2e d  of  char)) 


(*USER  WORKFILE  STUFF*) 


INFOREC  =  RECORD 

SYMFIBP,C0DEFI3P:  FI3P; 

errsym,errblk»errnum:  integer; 

SLOWTERM, stupid:  BOOLEAN; 

altmode:  char; 
gotsym,gotcode:  boolean? 
workvid.symvid,codevid:  vid; 
worktid,symtio»codetid:  tid 
end  (*inforec*)  ; 


(♦WORKFILES  for  SCRATCH*) 

(♦error  stuff  in  edit*) 

(♦student  programmer  ID!!*) 
(*WASH0UT  CHAR  FOR  COMPILER*) 
(*TITLES  ARE  MEANINGFUL*) 
(♦PERM&CUR  WORKFILE  VOLUMES*) 
(*PERM&CUR  WORKFILES  TITLE*) 


SEGraNGE  =  O..MAXSEG; 

segjesc  =  record 

diskador:  integer; 
codeleng:  integer 
end  (*segdesc*)  ; 


(♦CODE  SEGMENT  LAYOUTS*) 


(*REL  BLK  in  C0DE...A3S  IN  SYSCOM""*) 
(»»  BYTES  TO  READ  IN*) 


(♦DEBUGGER  STUFF*) 


BYTERANGE  =  0..25b; 

TRiCKARRAY  =  ARRAY  CO. .03  OF  INTEGER;  (*  FOR  MEMORY  DIDDLING*) 
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^'^SC-jF  = 


r-   —   A 


f^'iSCW; 


(*|>^ARK  STACK  RECOKD  POINTER*) 


MSCiA!    -    RECORD 

STATLInK:    MSCwP;        (*POirjTER 

dynli'jk:  mscwp;   (♦pointer 
msseg.msjtab:  '"trickarkay; 
MSiPc:  integer; 
localoata:  trickarray 

END  (*MSCW*)  ; 


TO  PARENT  MSCW*) 
TO  CALLER'S  MSCW*) 


SYSCOMREC  = 


{♦SYSTEM  COMMUNICATION  AREA*) 
(*SEE  INTERPRETERS. ..NOTE  *) 
(♦THAT  WE  ASSUME  BACKWARD  ♦) 
(*FIELD  ALLOCATION  IS  DONE  *) 


RECORtJ 

lORSLT:  iorsltwd; 
XEQERR;  integer; 
sysunit:  unitnum; 
bugstate:  integer; 
gdiRp:  dirp; 
lastmp,stkbasetbombp: 


(♦RESULT  OF  LAST  10  CALL*) 
(♦REASON  FOR  EXECERROR  CALL*) 
(♦PHYSICAL  UNIT  OF  BOOTLOAD*) 
{♦DEBUGGER  INFO^) 
{♦GLOBAL  DIR  POINTERtSEE  VOLSEARCH*) 

MScwp; 


INTEGER; 

{♦WHERE  XEQERR  BLOWUP  WAS*) 
(♦MORE  DEBUGGER  STUFF^) 

OF  integer; 

{♦DRIVERS  PUT  RETRY  COUNTS*) 
83  OF  INTEGER; 


memtop,seg,jtab: 
bombipc:  integer; 

HLTLINE:  INTEGER; 
3RKPTS:  ARRAY  CO. .33 
retries:  INTEGER; 

expansion:  array  cc. 
hightime,lowtime:  integer; 

MISCINFO:  PACKED  RECORD 

NOBREAKt STUPID. SLOWTERM* 

hasxycrt,haslccrt,has851oa»hasclock:  boolean; 

USERKIND:(NORMALi  AQUIZ.  booker.  PQUIZ) 

END; 

CRTTYPe:  INTEGER; 

crtctrl:  Packed  record 

rlf.ndfs.eraseeol.eraseeos. home. escape:  char; 

BACKSPACE:  char; 

fillcount:  0..255; 
clearscreen.  clearline:  char; 

prefixed:  PACKED  ARRAY  CO, .83  OF  BOOLEAN 

END; 
crtinfo:  packed  record 
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264 

VAR 


^'IDTH, height:  INTEGER; 

RIGHT, LEFT, DOrtiJfUP:    CiMR; 

3ADCH,CHAR0EL, STOP, BREAK, FLUSH, EOF:  CHAK; 

ALTViODE,LIrjEDEL:    CHAR; 

BACKSPACE, ETX, prefix:  CHAR; 

prefixed:  packed  array  co,,133  of  boolean 
End; 

SEGTABLE:  ARRAY  CSEGRANGEJ  OF 
RECORD 

codeunit:  unitnum; 

CODEDESc:  SEGDESC 
END 
END  <*SYSCOM*); 


MISCINFOREC 


=  RECORD 

msyscom: 
end; 


SYSCOMREC 


^SYSCOMREC; 

array  CO. .53  OF  FIBP; 


syscom: 

GFILES: 

userinfo:  inforec! 
emptyheap:  '^integer 
inputfib,0utputfib» 
systerm,swapfib:  fi 
syvid.dkvid:  vio; 
thedate:  DATEREC; 
debuginfo:  '^integer 
state:  cmdstate; 
pl:  string; 
IPOT:  array  CO. .4: 
filler:  stringcfill 
digits:  set  of  'o'* 

UNITabLE:  ARRAY  CUN 
RECORD 

uvid: 

CASE 
TRU 
END  (*U 
FiLE-gAME  :  FILE.TAB 


BP; 


OF  INTEGER; 
_LEN3; 


(♦MAGIC  PARAM,.,SET  UP  IN  BOOT*) 
(♦GLOBAL  FILES*  0=INPUTt  1=0UTPUT*) 
(♦WORK  STUFF  FOR  COMPILER  ETC*) 
(♦HEAP  MARK  FOR  MEM  MANAGING*) 
(♦CONSOLE  FILES, ..GFILES  ARE  COPIES^) 
(♦CONTROL  AND  SWAPSPACE  FILES*) 
(♦SYSUNIT  VOLID  &  DEFAULT  VOLID^) 
(♦TODAY. ..SET  IN  FILER  OR  SIGN  ON^) 
(♦DEBUGGERS  GLOBAL  INFO  WHILE  RUNIN^) 
(♦FOR  GETCOMMAND^) 

(♦PROMPTLINE  STRING. ..SEE  PROMPT^) 
(♦INTEGER  POWERS  OF  TEN^) 
(♦NULLS  FOR  CARRIAGE  DELAYS) 


itnumj  of  (♦o  not  used+) 

vid;    (♦volume  id  for  unit^) 
uisblkd:  boolean  of 
e:  (ueovblk:  integer) 

nitable*)  ; 
LE; 
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2bH  (* 

264  (♦  SYSTcv-  PROCEDURE  pOKWARD  DFCLARATIONS  *) 

264  (*  THESE  ARE  ADDRESSED  BY  OBJECT  CODE...  ♦) 

^3'+  (*   DO  NdT  MOVE  v^'ITHoUr  CAREFUL  THOUGHT   *) 
264 

1  PROCEDURE  EXECERROR{ 
I    FORWARD 

FiNiT(VAR  f:  fib;  window:  windowp;  recwords:  integer); 


■*) 


FRESET(VAR  F:  FIB) ; 


1  PROCEDURE 

4  FORWARD 

1  PROCEDURE 

2  FORWARD 

I  PROCEDURE  FOPENCVAR  f:  fib;  var  ftitle:  string; 
3  fopenold:  boolean;  junk:  fibp); 

5  FORWARD 

fclose{var  f:  fib;  ftype;  closetype); 


fgeT{var  f:  FIB) ; 

FPUTIVAR  F:  FIB) ; 


1  PROCEDURE 
3    FORWARD 

1  PROCEDURE 

2  FORWARD 

1  PROCEDURE 

2  FORWARD 
1  PROCEDURE  XSEEK; 
1    FORWARD; 

3  FUNCTION  FE0F(VAR  F:  FIB);  BOOLEAN; 

4  FORWARD 
FEOLN(VAR  F:  FIB):  BOOLEAN; 


3  FUNCTION 

4  FORWARD 
1  PROCEDURE 

3  FORWARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 
1  FORWARD 
1  PROCEDURE 
1  FORWARD 
1  PROCEDURE 

3  FORWARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 


FREADINT(VAR  F;  FIB;  VAR  i:  INTEGER); 
FWRITEINT(VAR  F:  FiB;  I.RLENG:  INTEGER); 

xreadreal; 
xwritereal; 

FREADCHAR(VAK  F:  FIB;  VAR  CH:  CHAR); 
FWRITECHAR(VAR  f:  FIB;  CH:  CHAR;  RLENG;  INTEGER); 
FREADSTRIN3(VAR  F;  FI3;  VAR  S:  STRING;  SLENG:  INTEGER); 


4    FORWARD. 

1  PROCEDURE  FWRITESTRIN6(VAR  F:  FIB;  VAR  S;  STRING;  RLENG:  INTEGER); 
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19; 
20 

^o 

21 

2i; 

22; 

22; 
23; 
23; 
24; 
24; 
25; 
25; 
26: 
26; 
27; 
27; 
28; 
28; 
28; 
29; 
29; 
29; 
29; 
29; 
30; 
30; 
30: 
31: 
31: 
32: 
32: 
33; 
33: 
33; 
34: 
34; 
35: 
35; 
35; 
36; 


^  FORWARD 

1  JRUCEDJRI 

5  forwar: 

1  -rocequi^e: 

2  FjR'wARD 

1  PROCEDURE 

2  FOR'^ARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 

5  FORWARD 
1  PROCEDURE 
5  FORWARD 
1  PROCEDURE 


FWRITE3YTEs(VAh  F;  FI3;  VAR  A:  WINDOW;  RLENG»ALENG:  INTEGER); 
FRE,aDL^(\/AR  F:  FIB)  ; 

fwriteln(var  f:  fiB) ; 

SCONCAKVAR    UESTtSRC:    STRING;    DESTLENG:    INTEGER); 
SIi\lSERT(\/AR    SRCDEST:    STRING;    DESTLENG ,  INSINX:    INTEGER); 

scoPY(VAR  srciDest:  string;  srcinx,copyleng:  integer); 

SDELETEiVAR  UEST:  STRING;  DELINX i DELLENG:  INTEGER); 


4  FORWARD. 
3  FUNCTION  SP0S(VAR  TARGET. SRC:  STRING):  INTEGER; 

5  FORWARDv 
3  FUNCTION  FBL0CKI0(VAR  F:  FIB;  VAR  A:  WINDOW;  i:  INTEGER; 

6  NBL0CKS,RBL0CK;  INTEGER;  DOREAD:  BOOLEAN):  INTEGER; 

9  FORWARD; 

1  PROCEDURE  FG0T0XY(X»Y:  INTEGER); 

3  FORWARD; 

3 

3  (*  NON  FIXED  FORWARD  DECLARATIONS  *) 

3 

3  FUNCTION  volsearch(vaR  fvid:  VXD;  lookhard:  boolean; 

5  VAR  fdir:  dirp):  unitnum; 

6  forward; 

1  procedure  writeoir(funit:  UNITNUM;  fdir:  dirp); 

3  FORWARD; 

3  function  OIRSEARCHCVAR  FTID:  TID;  FINDPERM:  BOOLEAN;  FDIR:  DIRP):  dirrange; 

6  FORWARD; 

3  FUNCTION  sCANTITLE(FTITLE:  STRING;  VAR  FVID:  VID;  VAR  FTID:  TID; 

6  VAR  FSEGS:  INTEGER;  VAR  FKINO:  FILEKIND):  BOOLEAN; 

49  FORWARD 

OELENTRYCFINX:  DIRRANGE;  FDIR:  DIRP); 


1  PROCEDURE 

3  FORWARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 
1  FORWARD 


INSENTRY(VAR  FENTRY:  DIRENTRY;  FINX:  DIRRANGE;  FDIR:  DIRP); 

HOMECURSOR; 


328  0  37:D      i  PROCEDURE  CLEARSCREEN ? 

329  0  37:D      1    FORWARD; 

330  0  38:D  1  pKOCEDUKE  CLtARLINE ; 

331  0  38:D      1    FORWARD; 

332  0  39: J  1  PROCEDURE  PROMPT; 

333  0  39:D  1    FORWARD; 

334  0  1+0:0  3  FUNCTION  SPACEWAIT  ( FLUSH :  BOOLEAN):  BOOLEAN; 

335  0  'tO:D  <+    FORWARD; 

336  0  1+1:0  3  FUNCTION  gETCHAR  ( FLUSH:  BOOLEAN):  CHAR; 

337  0  11:D  4    FORWARD; 

338  0  42:d  3  FUNCTION  FETCHDIR (FUNIT:UNITNUM)  :  BOOLEAN; 

339  0  42:d  1+    FORWARD; 

340  0  43:D  1  PROCEDURE  COMMAND; 
S'+l  Q  13:D  1    FORWARD; 

342  0  43:D  1 

343  0  43:D  1  {*$I  GLOBALS.TEXT*) 

344  0  43:d  1 

3'*5  1  1:D  1  SEGMENT  PROCEDURE  YAL0E(INN»0WWT  :  FIBP); 

5'*7  1  1:D  3  (*    COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.     *) 

^^^  1  IJD  3  (♦    PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-      ♦) 

^^^  1  ISO  3  (*    TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE     m) 

350  1  1:D  3  (*    OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS,            *) 

352  1  1:D  3 

353  1  l:0  3  (*  YALOE  ♦  YALOE  *  YALOE  *  YALOE  ♦  YALOE  *  YALOE  *  YALOE  *  YALOE  ♦ 
^^'*  1  1:D  3   *  THIS  TEXT  EDITOR  IS  BASED  ON  THE  COMMAND  STRUCTURE 

355  1  i:0  3   *  OF  THE  RT-11  SYSTEM  TEXT  EDITOR,   INITIALLY  STRUCTURED 

356  1  1:D  3   *  AND  WRITTED  BY  RICHARD  KAUFMANN  AND  GREG  DAVIDSON, 

357  1  1:D  3   *  LATER  MODlFIEDt  ENHANCED,  AND  QUICKENED  BY  KEITH  SHILLINGTON, 

358  1  1:d  3   *  RELEASED  CONTINUOUSLY  FROM  EARLY  JUNE  1977, 

359  1  1:D  3   *  LATEST  FIXES  BY  ROGER  SUMNER  FOR  1,3   8-AUG-77 

360  1  1:D  3   *  ll-AUG-77  KEITH  SHILLINGTON   BACKSPACING  CHANGES 

361  1  1:D  3   ♦  13-SEP-77  KAS  &    RTS  ALPHA  LOCK  AND  BACKSPACE  FIX 

362  1  1:D  3   ♦  24-SEP-77  RTS  REMOVLS  ALPHA  LOCK, ..PUT  INTO  1,3B  INTERP 

363  1  1:D  3   *   7-0CT-77  MADE  A  NON-SYSTEM  PROGRAM, . ,RSK  DYNASTY  TAKES  OVER 
36*+  1  1:D  3   *   9-FE3-78  BUGS  ABOUT  HEAP  REMAIN. ..1.4  OUT  THE  DOOR  ANYWAY 

365  I  1:D  3   *            SYSTEM  WORKS  OK  WITH  DIRTY  FIX  IN  WRITEOIR! 

366  1  1:D  3   *  YALOE  *  YALOE  *  YALOE  *  YALOE  *  YALOE  *  YALOE  *  YALOE  »  YALOE  *) 

367  1  1:D  3 

368  1  1:D  3   CONST 
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36  3    1 

i:d 

3 

570    1 

x:d 

S 

371    1 

i:d 

5 

372    1 

i:o 

3 

373    I 

llu 

3 

374    1 

i:d 

5 

375    1 

i:D 

3 

376    1 

i:o 

3 

377    1 

i:d 

3 

378    1 

i:d 

3 

379    1 

i:d 

3 

380    1 

i:d 

3 

381    1 

i:d 

7 

382    1 

i:d 

9 

383    1 

i:d 

10 

38tf    1 

i:d 

11 

385    1 

i:d 

12 

386    1 

i;d 

14 

387    1 

i:d 

15 

388    1 

i:d 

16 

389    1 

i:o 

16 

390    1 

i:d 

16 

391    1 

i:o 

16 

392    1 

i:o 

16 

393    1 

i:d 

36 

39<f    1 

i:o 

36 

395    X 

i:o 

36 

396    1 

i:d 

36 

397    1 

i:d 

37 

398    I 

i:d 

77 

399    1 

2:d 

3 

400    1 

2:d 

3 

401    1 

3:d 

3 

402    1 

3:o 

0 

t03    1 

3:i 

0 

404    1 

3:o 

10 

«+05    1 

3:o 

26 

'♦06    1 

ttD 

3 

107    1 

4:0 

3 

408    1 

i:d 

3 

•tog   1 

'+:d 

3 

CHANtiifvlS 


RET  =  13;   TAB  =  9; 

CTRLX  =  (*030O*)  24 

DCl  =    (*0210*)  17 

EXECSIZE  =  lOOO; 

MAXMAC  =9;  (* 

SHIFT  =  15; 
TYPE 

FILEBUF  =  PACKED  ARRAYC 0 . . 1023D  OF  CHAR; 

CO!«iARRAY  =  PACKED  ARRAYC0..99D  OF  CHAR; 

BUFCHUNK  =  PACKED  ARRAYC 0 . .9993  OF  CHAR; 
VAR 

IivJ.ENOpOSiCURSOR:  INTEGER! 

bufsizeiBufend:  integer; 
equallength:  integer' 

ESC:  CHAR5 

CTRLu:  integer; 

back,acr:  char; 

EXEC:  '^comarray; 

buf:  ^bufchunk; 

macros:  arrayc0..maxmac3  of 

RECORD 

LGTH:  INTEGER; 

EXEC:  '^COMARRAY 
ENO; 

option:  packed  record 
listsize:  o.,ioq; 

ONOFF:  BOOLEAN 
END; 
lOFlLE:  FILE; 
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THIS  HAS  IMPACT  ON  THE  CODE...  *) 


FUNCTION  command:  BOOLEAN; 


forward; 
integer; 


FUNCTION  mIN(A«B;INTEGER): 

begin 

IF  a>b  then  min  :=  b  else  min  :=  a 
end; 

FUNCTION  nEWFIN:  BOOLEAN;  (*  TRUE  IF  ERROR  OCCURS  ♦) 

LABEL  i; 

VAR 

nblocks,stashsize,stashedat:  integer; 


mo 

4:d 

6 

111 

4:c 

10 

112 

4:o 

0 

m3 

4:i 

0 

414 

4:i 

3 

415 

4:3 

20 

416 

4:3 

23 

417 

4:3 

35 

418 

4:4 

38 

419 

4:3 

45 

420 

4:4 

47 

421 

4:5 

47 

422 

4:5 

79 

423 

4:5 

82 

424 

4:4 

84 

425 

4:3 

84 

426 

4:3 

87 

427 

4:5 

90 

428 

4:5 

93 

429 

414 

98 

430 

4:3 

98 

fSl 

4:3 

107 

«»32 

*+:3 

124 

433 

4:5 

m 

434 

4:5 

147 

435 

4:5 

179 

436 

4:5 

182 

437 

4:5 

185 

438 

4:4 

187 

439 

4:3 

187 

440 

4:3 

192 

441 

4:5 

195 

442 

4:5 

200 

443 

4:4 

213 

444 

4:3 

213 

445 

4:3 

216 

446 

4:5 

221 

447 

4:5 

226 

448 

4:5 

233 

449 

4:5 

240 

450 

4:5 

253 

STASHCURSOK.rjPAGES.I.NEXT:     Ii'^JTEGFR! 
DIDDLEO:    BOOLEAsli 
SEGIivl 

NEWFIN  :=  false; 

IF  BLOCKREAD(IOFlLE»ItO,2)  =  0  THEN  BEGIN  (*  Ok  *) 

stashcursor  :=  cursor; 

stashsize  :=  endpos  -  cursor;  stashedat  :=  bufend-stashsize; 

IF  (stashedat  >  cukscr)  then  (*  there  is  room  *) 

!^OVERIGHT{BUF'^C CURSOR 3.  BUF'^C stashedat D, STASHSIZE) 
ELSE 

BEGIN 

i^RlTELN(OUTPUT.«NOT  ENOUGH  SPACE')? 

NEWFiN  :=  true; 

GOTO  l; 

end; 

DIDDLED  :s  FALSE; 

IF  ODD(CURSOR)  THEN  BEGIN 

DIDDLED  :=  true; 

CURSOR  Js  CURSOR  +1; 

end; 

NBLOCKS  :=  (STASHEDAT  -  CURSOR)  DIV  512; 

NBLOckS  :=  BLOCKREAD(lOFlLE»BUF'^CCURSOR3tNBLOCKS)| 

IF  (NOT  E0F<I0FILE)>  OR  (lORESULT  <>  Q)  OR  (ODD(NBLOCKS) )  THEN  BE6IN 

CLOSE<IOFILE)| 

WRITEUNC OUTPUT, •NOT  ENOUGH  SPACE*); 

CURSOR  :=  STASHCURSOR; 

NEWFIN  :=  TRUE; 

GOTO  U 
ENDS 

NPAGES  J=  NBLOCKS  DIV  2; 
IF  DIDDLED  THEN  (*  UGH  *)  BEGIN 

CURSOR  :=  CURSOR  -1; 

HOVELEFT(BUF'^CCURSOR  +  lD,BUF'^CCURSORDtNPAGES*1024); 

end; 

NEXT  :=  cursor; 

WHILE  NPAGES  >  0  DO  BEGIN 
NPAGES  :=  NPAGES  -1; 
CURSOR  :=  CURSOR  +1023; 
NEXT  :=  NEXT  +1024; 
I  :=  SCAN(-1024«<>CHR(0) i3UF^CCURS0R3) ; 

CURSOR  :=  CURSOR  +1  +i;  (♦  point  at  first  nul  *) 
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308 

^31  1  ^-'^  ^iC  IF    :,PAr,c:S    >     0     THLi-J       MOVr:L^FT(aUF'"C[JEXT3,BUF"LLURSCRD,102'+)  ; 

"^^^  1  "^'^  27i  i:                   (*    J\is    IS    .-.'HIKE    THE    .vOJrlD    IS    CLOSED    AND    HEALED    *) 

'+S'+  1  '+:-5  27b  CLGSLdoriLL); 

^^'^  1  ^+^3  ^S2  ^i0VLLc.FT('JLJF"CSTASHECATJ.3UF'>CCURS0iniSTASHSlZE)  ; 

'+-0  1  4:3  22.3  Ef^iUPl'::     :=    STASHSIZE    +CURSO^; 

^+57  1  ^15  ^^^■  buf^cenopos:  :=  chk(O); 

'+^i^  1  ^'i  -^S-a  CURS-R  :=  STASHCURSOR; 

'+59  1  4:2  301  END; 

'+6G  1  '+:o  301  end; 

'+61  1  H:o  320 

'+62  1  5:D  1  PROCEDURE  INITIALIZE; 

'+63  1  5:D  1  VAR 

'+^'+  1  5:D  1  3UFMAKER:  '^BUFCHUfMK; 

'+65  1  5:d  2  spacemaker:  '^COMARRAY; 

"+66  1  5:d  3  here:  -integer; 

'+67  1  5:o  4  limit:  integer; 

'+68  1  5:d  5  test:  boolean; 

'+69  1  5:0  0  BEGIN 

'+70  1  5:i  0  write(3utpjt,»yaloe:' ) ; 

'+71  1  5:i  16  IF  NOT  SYSCOM'^.MISCINFO.SLOWTERM  THEN 

"+72  1  5:2  27  WRITe(OUTPUT» 

'+73  1  5:2  27  '  -  ?  <ESC><ESC>  FOR  DETAILS')? 

'+7'+  1  5:i  64  WRITELN(OUTPUT)  ; 

'+75  1  5:i  70  NEW{BUF);  (*  base  of  THE  BUFFER  *) 

'+76  1  5:i  77  BUFSIZE  :=  SIZEOF  ( BUFCHUNK )  ; 

'*77  1  5:i  82  LIMIT  :=  ORD  ( SYSCOW^.LASTMP )  ; 

'+78  1  5:i  88  REPEAT 

'+79  1  5:2  38  MARK{hERE); 

'+90  1  5:2  92  TEST  :=  ((LIMIT  -  ORD  (  HERE  )  X5000  )  AND  ((LIMIT  -  ORD  (HERE  )  )  >0  )  ; 

'+81  1  5:2  107  IF  NOT  TEST  THEN 

'+32  1  5:3  111  BEGIN 

'+85  1  5:4  111  fJEW(BUFMAKER)  ; 

'^8'+  1  5:4  118  BUFSIZE  :=  BUFSIZE  +SIZEOF  ( BUFCHUNK ) 

'+85  1  5:3  122  END; 

"+86  1  5:i  125  UNTIL  TEST; 

'+87  1  5:i  128  IF  BUFSIZE  <  0  THEN  BUFSIZE  :=  32000; 

'+88  1  5:i  138  NEW(EXEC); 

'^89  1  5:i  143  FOR  I  :=  1  TO  9  DO  NEW  { SPACE^IAKER )  ;  (*  CREATE  SPACE  FOR  BASIC  COMMAND  *) 

'+^0  1  5:i  166  FOR  I  :=  0  TO  MAX>«4aC  DO 

'+91  1  5:2  177  ^ACROSCn.EXEC  :=  NIL; 


^+92 

1 

b:i 

193 

^35 

X 

"■:i 

1V9 

49'+ 

b:i 

29b 

495 

b;i 

208 

496 

5:i 

211 

497 

b:i 

214 

498 

5:i 

224 

499 

5:i 

234 

5QQ 

5:i 

244 

501 

5:2 

244 

502 

5:4 

249 

503 

5:4 

289 

504 

5:5 

295 

505 

5:6 

331 

506 

5:5 

331 

507 

5:4 

335 

508 

5:6 

337 

509 

5:6 

356 

510 

5:7 

365 

511 

5:6 

383 

512 

5:5 

^06 

513 

5:3 

406 

514 

5:4 

408 

515 

5:4 

415 

516 

5:3 

450 

517 

5:i 

450 

518 

5:i 

453 

519 

5:o 

456 

520 

5:o 

476 

521 

5:o 

476 

522 

6:d 

1 

523 

6:d 

1 

524 

6:d 

2 

525 

6:d 

3 

526 

6:d 

4 

527 

6:o 

0 

528 

&:i 

0 

529 

&:i 

3 

530 

&:i 

7 

531 

6:i 

14 

532 

6:i 

22 

CURSOR  :=  o;  enqpos  :=  0; 

OPTION. QivlOFF     :=    FALS1^5 
uJFENO    :=    3UrSIZE; 
I    :=    0; 

ACR   :=  chr(re:t)  ; 

BACK    :=    SYSCOM'.CRTCTRL, BACKSPACE; 
ESC    :=    SYSCOW^.CRTINFO.ALTMODE; 
CTRLU    :=    OKD(SYSCOiw'".CRTINFO,LirNiEOEL)  ; 
WITH    USERINFO    DO 
IF    GOTSYM    THEN    3EGIN 
OPENOLD(IOFILE,CONCAT(SYMVIDt »:• .SYMTID) ) ; 
IF    IMEiAlFIfM    THEN 

BEGIN    i«IRITELN(OUTPUT, 'LOST    WORKFILE    SOURCE*) 

GOtsYM    :=    FALSE 
END 
ELSE    BEGIN 

WRlTE(OUTPUT»»WORKFILE    »)! 
IF    lENGTH(WORKTID)    >    0    THEiM 

^RlTE(OUTPUT,WORKTID»'     •); 
WRlTELiM(OUTPUT,»READ    IN»); 
END 

END  Else  begin 
ENDPos  :=  o;  BUF'^co]  :=  chrco); 

WRlTELN<OUTPUTt«NO  WORKFILE  TO  READ»){ 
END? 

CURSOR  :=  o; 
equallength  :=  o; 

ENDi 


> « 


PROCEDURE  NEW0JTL00K5 
\/AR   IriNTEGER; 

stashcursor:  integer; 
P:  '^integer; 
com:  '^filebuf; 

BEGIN 

stashcursor  :=  cursor; 

MARK(P) ; 

NEW (COM) ; 

FILLCHAR(COM'"C03,10  24,CHR(0)  )  ; 

CURSOR  :=  o; 
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3l[) 

553  i  6:1  2b  IF    dLUCKwHlTt:U0FlLE,C0M"»2)     =    2    THtN 

534  1  6:2  44  WHILE     (CJRSOH    +    IQZ6)     <    EfjDPOS    DO    BESH^J 

535  1  6:4  53  I     :=    SCAN(-102?.     =    CHR(RET),     3UF''CCURS0R    +1022:)? 
oio  1  6:4  70  r^OVELEFT(BJF"CCUKSOR3,COM*»1023  +  I)  ; 

537  1  6:4  61  Fli.LCHAH(COM-Cl023+i:,ABS(I)+l,CHR(0)  )  ; 

53B  1  d:4  ?4  IF  BLOCKUKITE(IOFILE.COM''.2>  <>2  THEiM  BEGIN 

539  1  S,:6  113  REt-EASEtP); 

5fQ  1  6:6  117  lAlRlTELN(OUTPUTt     •OUTPUT    FILE    ERROR:    HELP*); 

S'+l  1  6:6  156  CLOSEdOFILE)  ; 

5'+2  1  6:6  162  EXlT(CC[>^i^AND)  ; 

543  1  6:5  166  EMj; 

544  1  6:4  166  CURSOR  :=  CURS0R+1023+I ? 

545  1  6:3  175  END! 

546  1  6:1  177  IF  (CURSOR  <  ENDPOS)  THEN  BEGIN 

547  1  6:3  182  FILLCHAR(BUF'^CENUPOS3,1024-(ENDPOS-CURSOR),CHR(0))  5 
546  1  6:3  194  MOVELEFT(BUF''CCuRS0RDiCOM'",1024)  ; 

549  1  6:3  203  IF  Bl-0CKWRITE(I0FILE.C0M'*»2)  <>2  THEN  BEGIN 

550  1  6:5  222  RELEASE(P); 

551  1  6:5  226  WRITELN(0UTPUT»»0UTPUT  FILE  ERROR,   HELPlM; 

552  1  6:5  267  CLOSE(IOFILE) ; 

553  1  6:5  273  EXIT(COMMAND) ; 

554  1  6:4  277  end; 

555  1  6:2  277  end; 

556  1  6:1  277  RELEASE(P); 

557  1  6:1  281  CLOSE(IOFILEtLOCK) ! 

558  1  6:1  287  CURSOR  :=  STASHCURSOR; 

559  1  6:0  290  END; 

560  1  6:0  306 

561  1  7:D  1  PROCEDURE  CLOSETHEWORLO ( VAR  CH:  CHAR)? 

562  1  7:D  2  \/AR 

563  1  7:0  2  LTITLE  :  STRINGC293; 

564  1  7:D  17  EXITSET:  set  OF  ♦A»..'Z'? 

565  1  7:0  0  BEGIN 

566  1  7:1  0  EXITSET  :=  C »E • . 'E» 1 'U* , »U* , 'R* t 'R* 3? 

567  1  7:1  25  REPEAT 

568  1  7:2  25  IF  NOT  (CH  IN  EXITSET)  THEN  BEGIN 

569  1  7:4  36  CLEARSCREEN? 

570  1  7:4  39  PL:='QUIT:  U(PDATE  work  FILE.  E(XIT  WITHOUT  UPDATE.  R(ETURN  TO  EDITOR* ? 

571  1  7:4  111  PROMPT?  READ(INPUT.CH) ?  WRITELN ( OUTPUT ) 

572  1  7:3  127  END? 

573  1  7:2  127  IF  (CH=*U')  OR  (CH=»U»)  THEN 


'^^'^          1  "^-'^  133  wl  TH    USERI'JFO    LG    BE&IN 

^''^   ^  7:5  Ida  lTIT^l  :=  ♦♦syste'^.wRk.tlxt*  ; 

III  ]  I'"-  ^'''^                          (*IF  WE  GET  HERE  THEN  FILE  IS  LOCKED  ON  DISK  OK*) 

\'i  \  l\l  17^       SYi^viD  :=  srviu;  symtid  :=  'system. wrk. text*  ;  gotsym  :=  truej 

\''^  ^  ' '^  207         LTITlE  :=  **system.wRk.code' ; 

^^?  \  Z-^  230          OPENOLDdOFlLE. LTITLE);  CLOSE ( IOFILE , PURGE ) ; 

f„t  ■"  '^  '^"^"^                          30TCGDE  :=  FALSE;  CODETID  :=  •• 

^2^  i  7; 4  2d2      End 

583  1  7:i  257    UNTIL  CH  IN  EXITSET? 

SQ'^  1  7:o  267  end; 

585  1  7:3  282 

^86  1  7:o  2S2 

537  1  8:d  1  PROCEDURE  PROMPTS? 

5S6  1  8;C  1  vAR 

5S5  1  8:d  1   here:  -integer; 

590  1  8:o  0  3EGIN 

591  1  a:i  0   mark(HerE); 

592  1  3:i  ^   clearscreen; 

^:f  ^  ^-1  7    i^RlTELN(OUTPUT,'YET  ANOTHER  LINE  ORIENTED  EDITOR.')  5 

='''+  1  S:i  56    WRITELN(OUTPUT)  ; 

595  1  8:i  62    WRlTELf\j{OUTPUT» 

^^^  \  f'^  ^2          'ADVANCE   BEGINNING   CHANGE   DELETE   GET   INSERT   JUMP'); 

„«  \  l'\\  iJl    WRITELN(OUTPUT,»KILL   LIST   ?^ACRO  <DEFINITI0N>   NOW  <MACRO  EXECUTION>.  )  ; 

til  \  \\\  m         WRlTELN(OUTPUT,'guiT  <ESC  UPDATE>   READ  <FILENAME>   SAVE   UNSAVE   VERIFY')? 

Z-^l  ^  ®'l  272    WRITEL-J(0UTPUT, 'WRITE  <FILENAME>   EXCHANGE   ?ELP*); 

?°?  ^  ^-1  320    WRIT£LN(OUTPUT,'CTRL-X  (CAN)  TO  CANCEL  COMMAND  INPUT.')! 

"^^^  1  8:i  373    WRlTEL,g(OUTPUT); 

^?2  1  8:i  379    i«RlTELrj(OUTPUT.'THE  MACROS  YOU  HAVE  DEFINED  ARe:M; 

6^3  1  e:i  ^21          WRITE(0UTPUT,'  -  '); 

^0^+  1  8:i  't^O    FOR  I  :=  0  TO  MAX;'J|AC  DO 

fj5  1  9:2  151      IF  MACROSCn.EXEC  <>  NIL  THEN 

&0&  1  a:3  H61        WRIT£(0UTPUT.I,'  -  '); 

°07  1  6:i  489    WRITELM(OUTPUT) ; 

^°f  J  ?•!  "+95    WRITE(OUTPUT,'YOUR  TEXT  BUFFER  IS  'tSUFSlZE,'  BYTES.  '.ENDPOS); 

T1  \  V'}  ^^^    '^'R I  TELr,l(  OUTPUT,'  OF  WHICH  ARE  FILLED,  LEAVING  '  ,BUFSIZE-EIMDP0S)  ; 

"?  ^  ^'^  ^15    WRITE(0UTPUT,'Y0UR  "SAVE"  TEXT  IS  •  ,  BUFSI2E-BUFEND ,  '  BYTES'); 

bii  1  e:o  671  Ef^D; 

612  1  8:0  6Bd 

^i"  1  9:d  1  PROCEDURE  INCOMMAND; 

^I't  i  9:d  1  LABEL  1,2; 
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615 
6  lb 
617 

61b 

619 

b  t  u 

621 
622 
623 
624 
625 
626 
627 
626 
629 
630 
631 
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639 

e^u 

641 
642 
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645 
646 
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649 
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651 
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655 
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i 

X 

1 

1 
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1 

1 

1 

1 

1 
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1 
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1 

1 

1 

1 
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9:  J 
3:  J 

9:,,.. 

9 : :: 
9 : 3 
9:o 


9: 

9: 

Q  ' 

9: 

9: 

9; 

9:3 

9:3 

9:3 

9:2 

9:i 

9:i 

9:i 

9:i 

9:i 

9:i 

9:1 

9:i 

9:2 

9:3 

9:4 

9:5 

9:3 

9:3 

9:3 

9:q. 

9:5 

9:6 

9:6 

9:7 

9:7 

9:6 

9:7 


10 

12 

0 

G 

3 

11 

23 

?3 

5  9 

48 

55 

64 

64 

73 

76 

79 

32 

65 

98 

96 

109 

117 

117 

122 

132 

149 

154 

159 

164 

169 

169 

174 

177 

190 

210 

212 


ch:  cm 

F-ACTQK 

CNDLu: 

CRTESC 
SL3/i ,  iAi 
COijTRO 

;-EGl'^ 

FILLCH 

FACTOR 

WITH  S 

B£Gl 

SL 

CR 
UP 
EE 

end; 

WASBS 

CH  :  = 
I  :=  0 

EARNED 
ONEESC 
READ(K 
IF  EOL 
WHILE 
BEGI 
IF 


ON 
IF 
IF 


SCtwAhijEJ:     DCGLEAii; 

.:•' ; 

t  T  :     li'iTEvvER  ; 

CHA,<; 
♦JPfLEGL:  cha^; 
ASoS;  BOOLEAfvi; 
LS:  SET  OF  ChAR; 

A- (EXEC ".EXECS I ZE, ESC) ; 
:  =   ij ; 

y3C0M^,CRTCTRL.MISCIi\iF0    OG 

'j 

3w  :=  (backspace  =  chr{0));  {*  no  control  *) 
^el  ;=  crtinfo.chardelj 
tesc  :=  escape! 

:=  rlf; 
tl  :=  eraseegl 

;=  FALSE: 
•  • ; 

:=  FALSE; 

;=  FALSE; 
EY30ARD,CH) ; 

^J(  KEYBOARD)  THEN  CH  :=  ACR; 
(CH  <>  ESC)  OR  NOT  ONEESC  DO 

CH  =  CHR(SHIFT)  THEN 
IF  SYSLO^^'^.MISCINFC.HASSSIOA  THEN  (*KAS  8/15*) 

IF  FACTOR  =  128  THEN  FACTOR  :=  0  ELSE  FACTOR  :=  128; 
EFJSC  :=  (CH  =  ESC)  ; 
ONEESC  THEN  GOTO  1; 
CH  =  CHDEL  THEN 

IF  (I  >  0)  THEN 
BEGIN 

I  :=  PRED(i) ; 

IF  SLOW  THEN 

IF  WASBS  THEN  WRITE ( OUTPUT , EXEC'CI 3 ) 

ELSE  WR ITE(  OUTPUT,  ♦%♦  .EXEC^CID) 
ELSE 

IF  EXEC^Ci:  =  CHR(TAB)  THEN 
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9:3 

219 
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3:7 

2 '6  3 
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?72 
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272 

660 
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661 

9:5 
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9:6 
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663 

9:5 

3Q0 

66i+ 

9:6 

302 

665 

9:7 

302 

666 

9:7 

324 

667 

9;  6 

340 

66b 

9:5 

340 

669 

9:5 

358 

670 

9:4 

378 

671 

9:3 

378 

672 

9:4 

380 

673 

9:5 

385 

674 

9:6 

385 

675 

9:7 

396 

676 

9:a 

396 

677 

9:8 

'too 

678 

9:8 

405 

675 

9:8 

fla 

660 

9:9 

'+31 

681 

9:7 

^+41 

682 

9:6 

441 

663 

9:8 

446 

631 

9:a 

449 

635 

9:8 

455 

686 

9:7 

459 

687 

9:5 

459 

663 

9:4 

459 

669 

9:5 

461 

690 

9:6 

468 

691 

9:7 

468 

692 

9:7 

479 

693 

9:7 

487 

69*+ 

9:7 

491 

695 

9:& 

494 

696 

9:5 

496 

EhjC 


FOK    T     :=    1    TO    a    DO    uMRlTECOUTpUTtQACK) 
ELSE    WRITE < OUTPUT, 3ACK,«     'iBACK); 


IF    (CH    =    CHPUCTRLU)  )     THEN 
3ESIi\ 

IF    SLOW    THEN 

i^R  I  TELN(  OUTPUT*  KZAP*  ) 
ELSE 
BEGIN 

WRITElN(OUTPUT,CRTESC,UP) ; 
WRITE(OUTPUT.CRTESC,EEOL) ; 
END; 
iAiHILE    (I    >    0)    AND    (EXEC^CIJ    <>    ACR)    DO    I    :=    PRED(I); 

if  i  <>  0  then  i  :=  succ(i)  else  write (output, »*• ) 

eno 

ELSE 

IF  (CH  <  •  •)  THEN 
3EGIN 

IF  ORD(CH)  IN  CRET»TAS,DC1]  THEN 
3EGIN 

i:  ExEC^ciD  :=  ch; 

I  :=  succ(i) ! 

IF  ONEESC  THEN  WRITE( OUTPUT, •$• ) 

ELSE  IF  ORO(CH)  =  OCl  THEN  WRITE (OUTPUT, CNR ( 7) ) 
ELSE  WRITE(OUTPUTtCH) 

END; 

IF    CH    =    CHR(CTRLX)    THEN    3EGIN 

I   :=  o; 

WRITELN(OUTPUT) ; 
EXIT(INCOMMAND) 
END 
END 
ELSE 

IF  (CH  <>  CHDEL)  AND  WASBS  THEN 
SEGIN 

IF  SLOW  THEN  WRITE ( OUTPUT ,♦%•) ; 
WRITE(OUTPUT,CH) ; 

EXEC^cn  :=  ch; 
I   :=  succ(i) 

END 
ELSE 
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631 

9;6 

4  96 

69& 

9:7 

511 

699 

9:6 

511 

700 

9:3 

519 

7'Jl 

9:o 

523 

702 

9:7 

526 

70i 

9:3 

523 

704 

9:3 

533 

705 

9:4 

542 

706 

9:6 

551 

707 

9:6 

614 

708 

9:6 

622 

709 

9:3 

627 

710 

9:7 

634 

711 

9:7 

636 

712 

9:9 

641 

713 

9:9 

649 

714 

9:o 

654 

715 

9:a 

658 

716 

9:5 

658 

717 

9:4 

658 

718 

9:6 

671 

719 

9:7 

671 

720 

9:7 

708 

721 

9:6 

711 

722 

9:3 

711 

723 

9:3 

719 

724 

9:3 

732 

725 

9:4 

737 

726 

9:2 

740 

727 

9:i 

744 

728 

9:i 

758 

729 

9:o 

763 

730 

9:o 

792 

731 

9:o 

792 

732 

2:d 

3 

733 

2:d 

3 

734 

2:d 

4 

735 

2:d 

5 

736 

2:d 

6 

737 

2:d 

10 

314 

IF    (CH    <>    CHDEIL)     AND    (Crl    >=    •     •  )    AND    (CM    <>    CHR(CTRLU))     THEN 

-EG  IN 

wRite:(output»ch)  ; 
EXEiCLiJ   :=  ch; 
I   :=  biuccd) 

eind; 

WASBs  :=  (CH  =  CHOE.L)  ; 

IF  I  >=  (EXECSIZE  -  eo  (♦WARNING*))  THEN 
IF  I  >  (EXECSIZE  -  2)  THEN  REPEAT 

rtRlTELN(OUTPUTt 'COMMAND  BUFFER  FULL.   TYRE  <ESC>  <ESC>  OR  C^X).')? 

READ{KEY30ARD»CH) ; 

IF  CH=CHR(CTRLX)  THEN  BEGIN 

I  :=  o;  ExiTdfjco'^^NiANO) 

ENO  ELSE 

IF  CH  =  ESC  THLN  BEGIN 
READ(KEYBOARU,CH) ; 
IF  CH  =  ESC  THEN 
EXIT(INCOMMAND) ; 
ENDJ 
UNTIL  FALSE 

ELSE  IF  NOT  WARNED  AND  (CH  =  ACR)  THEN 
3EGIN 

writeln{outputt»please  finish' , chr ( 7 )( *  bell  ♦)); 
warned:=true; 

end; 

READ(KEYBOARDtCH) ; 

IF  eolN(keyboard}  then  CH  :=  acr; 

IF  CH  >=  •  •  THEN 

CH  :=  chr(ord(ch)+factor) 

end; 

WRiTELr-HOUTPUT.  •$•  )  5 
i:=I-l; 

end; 

FUNCTION  cOMW|AND(*:  BOOLEAN  *); 

var  rcount:integer; 
thisch:  char; 
neg:5oolean; 
nuwiber:  set  of  •c'».*9'; 


7  33 

2:d 

IQ 

7  59 

ic:r 

1 

740 

io:o 

0 

7m 

io;i 

0 

7'I2 

io:i 

56 

7f3 

io:o 

60 

74t^ 

io:o 

72 

745 

ii:d 

1 

71+6 

ii:d 

3 

747 

ii:Q 

0 

748 

ii:i 

0 

749 

ii:i 

3 

750 

ii:3 

3 

751 

11:4 

8 

752 

11:4 

14 

755 

11:4 

29 

754 

11:4 

35 

755 

11:3 

40 

756 

11:3 

50 

757 

11:2 

56 

758 

11:3 

58 

759 

11:3 

74 

760 

11:3 

82 

761 

11:2 

87 

762 

11:0 

97 

763 

11:0 

114 

764 

i2:d 

1 

765 

12:d 

1 

766 

12:d 

1 

767 

12:0 

0 

768 

12:1 

0 

769 

12:2 

7 

770 

12:3 

7 

771 

12:3 

12 

772 

12:2 

18 

773 

12:1 

18 

774 

12:1 

25 

775 

12:2 

32 

776 

12:3 

32 

777 

12:3 

40 

773 

12:3 

51 

pRoccdure  sy;jtax(ERkch:  char); 
writ£l;\(0utput»errch«  •  :  is  im  errort  command  stopped,'); 

EXlT(COMMAiJD)  ; 

end; 

PROCEDURE  LINEPLACE(VAR  PTR:  INTEGER;  N;  INTEGER); 

\/AR  i:  integer; 
3EGIN 

PTR  :=  cursor;  (*  a  nice  PLACE  TO  START  *) 
IF  (N  <=  0)  THEN  (*  LOOK  BACK  *)  BEGIN 
REPEAT 

PTR  :=  PTR  -1; 

I  :=  SCAN(-(PTR  +  1)  i=ACRtBUF'*CPTRD)  ; 

PTR  :=  PTR  +i; 

N  :=  succ(N) ; 

UNTIL  (N  >  0)  OR  (PTR  <  0); 
PTR  :=  sUCC(PTR); 
END  ELSE  REPEAT 

I  :=  SCAN(ENDP0S-PTR-l»=ACR.BUF'^CPTR3)  ; 

PTR  :=  PTR+I+l; 

N  :=  N  -1; 
until  (n=0)  or  (ptr  =  endpos); 
end; 

PROCEDURE  OELETESTUFF; 
VAR 

count:  integer; 

BEGIN 

IF    (RCouNT    =    0)    THEN 
BEGIN 

Llr\iEPLACE(  COUNT.  0)  ; 

rcount  :=  COUNT  -  cursor; 

end; 
COUNT  :=cursor-i-rcoumt; 
IF  rcoj(mt<o  then 

begin 

IF  COUNT<0  then  COUNT  :=  o; 

mo VEuEFT{BUF'*i: cursor D,BUF'*C count 3 tENDPOS-CURSOR  +  l)  ; 

endpos:=endpos-(cursor-count) ; 
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316 


77^ 

i2:i 

53 

CURSOR  :=cou,jr; 

780 

12:2 

£,1 

tWD 

731 

12:1 

oi 

ELSE 

782 

12:2 

o3 

IF  (COUNT  >=  ENDPOS)  OR  (COUNT  <  0)  THEN 

786 

12:3 

72 

SEalN 

78^ 

12:4 

72 

EriSPos  :=  CURSUR;  buf'^ccursord  :=  chr(O); 

785 

12:3 

79 

END 

786 

12:2 

79 

ELSE 

787 

12:3 

31 

oE&lN 

788 

12:4 

cl 

vI0\/ELEFT(BUF'^CCGUNT:»BUF'^CCURS0R3,ENDP0S-C0UNT+1)  ; 

789 

i2:f 

32 

rNDPOS:=ENDPOS-( COUNT-CURSOR) ; 

790 

12:3 

99 

ENo; 

791 

12:0 

99 

end; 

792 

12:0 

112 

793 

12:0 

112 

794 

13:d 

1 

PROCEDURE  getter; 

795 

13;d 

1 

VAR 

796 

13:d 

1 

diRiSIze:  integer; 

797 

13:d 

3 

FOUNDtHARDENO:  BOOLEAN; 

798 

13:d 

5 

first:  char; 

799 

13:d 

6 

PATTERN, question:  STRINGC10035 

800 

13:d 

108 

801 

IHID 

1 

PROCEDURE  FINDIT; 

802 

i4:o 

0 

BEGIN 

303 

14:1 

0 

REPEAT 

80(f 

14:2 

0 

IF  DIR  <  0  THEN 

805 

m:3 

7 

3EGIN 

806 

14:4 

7 

CURSOR  :=  CURSOR  +  SCAN  ( -CURSOR,  =FIRST,BUF*[:CURS0R3)  ; 

807 

14:4 

22 

IF  CURSOR  <=  0  THEN 

808 

14:5 

27 

BEGIN 

809 

14:6 

27 

HARDEND  :=  TRUE; 

810 

14:6 

31 

CURSOR  :=  0; 

811 

14:6 

34 

EXIT(FINDIT) 

812 

14:5 

38 

END 

813 

14:3 

38 

END 

814 

14:2 

38 

ELSE 

815 

14:3 

40 

3EGIN 

816 

14:4 

40 

CURSOR  :=  CURSOR  +  SCAN  (  ENDPOS-CURSOR+1  »=FIRST  ,BUF'^CCURS0R3)  ; 

817 

14:4 

58 

IF  CURSOR  >=  ENDPOS  THEN 

318 

14:5 

Ow 

BEGIN 

319 

1 
X 

14:6 

63 

HARDEND  :=  TRUE; 

820 

14:6 

67 

621 

1 4 :  s 

70 

322 

14:5 

74 

323 

14:3 

74 

324 

14:2 

7^ 

825 

14:2 

35 

826 

14:2 

96 

827 

I4:i 

97 

828 

i4:o 

103 

829 

i4:u 

122 

830 

i3:o 

0 

831 

i3:i 

0 

832 

13:2 

7 

833 

13:3 

7 

834 

13:3 

14 

835 

13:2 

14 

836 

I3:i 

18 

837 

13: 1 

23 

838 

i3:i 

28 

839 

i3:i 

31 

840 

i3:i 

36 

841 

i3:i 

52 

842 

13:2 

57 

843 

I3:i 

90 

844 

I3:i 

98 

845 

I3:i 

103 

84S 

13  :i 

108 

847 

I3:i 

111 

848 

i3:i 

114 

849 

13:2 

114 

850 

13:2 

116 

851 

i3:i 

119 

852 

i3:i 

133 

853 

13:2 

136 

854 

13:3 

136 

855 

13:3 

171 

856 

13:2 

175 

857 

I3:i 

175 

858 

i3:i 

181 

859 

13  :i 

194 

360 

i3:i 

199 

CUF';S0R  :=  endpos; 

EXIT(FINUIT) 

MOVELEFKBUF-^CCUKSORJ.QUESTIONClJtSIZE); 
FOUND  :=  (aUESTlOM  =  PATTERN); 

CURSOR  :=  CURSOR  +  DIR 

UNTIL  FOUND 

Ef^lO  (*  FINDIT  *)  ; 

BEGIN 

IF  RCOJnT  <  0  THEN 
BEGIN 

RCOUNT  :r  -RCOUMT; 
DiR  :=  -1 
END 
ELSE  DiR  :=  l; 

u  :=  J+i; 
SIZE  :=  o; 

FIRST  :=  EXEC^CJ]; 

WHILE  EXEC^CJ  +SIZE3  <>  ESC  DO  SIZE  :=  SIZE  +1; 

IF  SIZE  >=  SIZE0F{PATTERN)  THEN 

MnS^^r^  WRITELN(0UTPUT,.FIND  TOO  LONG*);  EXIT(C0MMAND )  ENDi 

MOVELEFTCEXEC^CJD.PATTERNCID^SIZE); 

patternc03  :=  chr(size); 
Questioncod  :=  chr(size); 

HARDEND  :=  FALSE; 
FOUND  :=  FALSE? 
REPEAT 

findit; 

RCQUnT  :=  RCOUNT  -1 
until  (RCOUNT  <=  0)  OR  HARDEND; 
IF  HARDEND  THEN 

BEGIN 

WRlTELN(OUTPUT,PATTERNt'  NOT  FOUND'); 

exit(command) 
end; 
if  dir  <  0  then  cursor  :=  cursor  +1 
else  cursor  :=  cursor  +size  -1; 

J  :=  J  +SIZE; 

equallength  :=  size 
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8bl 

i3:o 

1^9 

362 

13:d 

2rri 

8S3 

i5:D 

1 

36"+ 

15  :o 

1 

365 

15:  J 

4. 

a£& 

i5:o 

Q 

867 

I5:i 

C 

368 

i5:i 

8 

369 

i5:i 

20 

870 

I5:i 

25 

871 

15:2 

30 

872 

15:3 

30 

873 

15:3 

83 

a7t^ 

15:3 

36 

875 

15:3 

91 

876 

15:2 

94 

877 

i5:i 

9tf 

878 

15:2 

99 

879 

15:3 

99 

880 

15:3 

135 

881 

15:2 

138 

882 

i5:i 

138 

883 

i5:i 

151 

88tf 

i5:i 

158 

885 

15:1 

163 

886 

I5:i 

168 

887 

15  :i 

171 

883 

i5:i 

178 

889 

15:q 

183 

890 

i5:o 

196 

891 

16  :d 

1 

892 

i6:o 

0 

893 

I6:i 

0 

89'+ 

i6:i 

10 

895 

I6:i 

21 

896 

i6:i 

32 

897 

16:2 

37 

898 

16  :o 

49 

899 

16:g 

o2 

900 

i6:o 

62 

901 

17:d 

1 

Tijc    ( *  Getter   *) ; 

PRQCErijRE:    INSCRTTCIXT; 
VAR 

sizeov^r:   ^joolean;     length iTE^ip:   iwtegfkj 
3e:gin 
sizeovep    :~  FALSE;     J   :=  j+i; 

LENGTH    :=    SCAN(I-J,  =  (ESC)  iExEC'CJ:])  ! 

TEMP   :=  endpos  +  leimgth; 

IF  (TEWP  >  3UFSIZE)  THEf^ 
3EGIN 

^RITELNCOUTPUT, 'INSERTION  TRUNCATED.  NOT  ENOUGH  SPACE*); 

SUE3VER  :=  TRUE' 

LENGTH  :=  BUFSIZE-ENDPOS; 

TEmip    :=    BUFSIZE5 

end; 
if  (temp  >  8ufend)  then 

BEGIN 

WRlTELN(OUTPUT,»"SAVE"  AREA  DELETED.'); 

BUFEND  :=  BUFSIZE; 
END? 

MOVERIGHTCBUF'^C CURSOR 3. BUF'CCURSOR+LENGTHD* BUFEND- (CURSOR+LENGTH))  J 
M0VELEfT(EXEC*CJ:,bUF'*CCURS0R3.LENGTH); 

endpos  :=  endpos  +length5 
cursor  :=  cursor  +length? 
equallength  :=  length; 

IF  SIZeOVER  THEN  EXIT(COMMAND) ; 
J  :=  J  +LENGTH; 
END  (*  INSERT  NEW  TExT  *) ; 

PROCEDURE  JUMP; 
BEGIN 

IF  RCOunT  =  0  THEN  LINEPLACE( CURSOR . 0 ) 

ELSE  CURSOR  :=  CURSOR  +  RCOUNT; 

IF  (CURSOR<0)  AND  (RCOUNT<0)  THEN  CURSOR  :=  0 

ELSE 
IF  (CURSOR<0)  or  <CURS0R>ENDP0S)  THEN  CURSOR  :=  ENDPOS; 
END; 


PROCEDURE  KILL; 


3iS 


902 

17  :d 

1 

903 

17  :q 

0 

904 

i7:i 

G 

905 

I7:i 

7 

9CS 

17:2 

14 

907 

17:3 

14 

908 

17:5 

25 

909 

17:3 

32 

910 

17:2 

39 

911 

i7:i 

39 

912 

17:2 

41 

913 

17:3 

41 

914 

17:3 

52 

915 

17:2 

59 

916 

i7:o 

59 

917 

i7:o 

72 

918 

i7:o 

72 

919 

18:d 

X 

920 

i8:o 

1 

921 

i8:o 

0 

922 

i8:i 

0 

923 

i8:i 

7 

924 

18:2 

14 

925 

i8:i 

24 

926 

18:2 

26 

927 

i8:o 

36 

928 

i8:o 

48 

929 

i8:o 

48 

930 

i9:o 

1 

931 

19:d 

1 

932 

19:d 

1 

933 

19:d 

2 

93<+ 

i9:o 

0 

935 

I9:i 

0 

936 

i9:i 

16 

937 

i9:i 

40 

938 

19: 1 

47 

939 

i9:i 

61 

940 

19:2 

76 

941 

19:3 

76* 

942 

19:3 

117 

VAK  position: IUTEGlR J 

BCGIrJ 

LINEPLACtCPOSITION.RCOUijT)  ; 
IF    RCOjrjT<  =  0    THEN 

8  E  S I  i'J 

'«10\/ELEFT(3UF''CcURS0R:,BUF'^CP0SITI0n:,  (ENDPOS-CURSOR  +  1)  )  ; 
ENOPOS  :=  ENDPOS  -  (CURSOR  -  POSITION); 
CURSOR  :=  CURSOR  -  (CURSOR  -  POSITION); 

UiO 
ELSE 
BEGI^J 

M0\/ELEFT(BUF'^CP0SlTI0ND,BUF'^CCURS0R3i  (ENDPOS-POSITION+1)  )  ; 
ENDPOS  :=  ENDPOS  -  (POSITION  -  CURSOR); 
END! 

end; 


PROCEDURE  LIST; 

VAR  POSITION:  INTEGER; 
BEGIN 

LINEPLACE(POSITION,RCOUNT) ; 

IF  rcount<=o  then 

UNIT^RITE(1(*    CONSOLE:    ♦),  BUF'^CPOSITION], CURSOR-POSITION) 
ELSE 

UNITWRITE(1(*    CONSOLE:    *)  «BUF'*CCURS0R3, POSITION-CURSOR) 

END; 


PROCEDURE  MACRODEFINITION; 
V/AR 

stopch:  char; 
lgth:  integer; 

BEGIN 

IF  (RCOUNT<0)  OR  ( RCOUNT>MAXMAC )  THEN  SYNTAX(»#M? 

IF  MACroSCRCOUNTJ.EXEC  =  NIL  THEN  NEW ( MACR0SCRC0UNT3. EXEC ) ; 

STOPCH  :=  exec^cj+id; 

LGTH  :=  SCAN(I-J.=ST0PCH.EXEC'*CJ+2])  ! 

IF  (LGTH  =  (I-J))  OR  (LGTH  >  SIZEOF (COMARRAY )  )  OR  (LGTH  =  0)  THEN 

BEGIN 

iAlRlTELN(OUTPUT, 'ERROR    IN    MACRO    DEFINITION*); 
EXiT(COMMAND) ; 
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9^+3 

19:2 

l^l 

cr^iD; 

9'4-4 

i9:i 

121 

W0VLLt-F'TlE:xEC''CJ  +  2jtMACR0Si:RC0UNT3.EXE:c 

9U.S 

I9:i 

167 

FILLCHARd^^ACROSCPCOU^JTD.EXLCCLoTrl+lD.S 

9^6 

19:1 

i^l 

macroscrcojntj.l&th  :=  LGTH; 

947 

19;  1 

163 

0  :=  J  +  i.uTH+2; 

9i+b 

i9:u 

170 

ETjn  (*  D-pIfC  ^'"ACRO  *)  ; 

=>U9 

19:0 

162 

95C 

2c:c 

1 

procldure:  nowexecutemacro; 

9bl 

2o:j 

1 

vAR 

952 

20:3 

1 

save:  record 

953 

20rD 

1 

exec:  '^comarhayj 

95f 

20  :d 

1 

i.j:  integer 

955 

2c:d 

1 

END; 

956 

2o:d 

^ 

MACNu^:  integer; 

957 

2o:d 

5 

error:  boolean; 

958 

2o:o 

0 

3EGIN 

959 

20:1 

0 

J  :=  J  +1; 

960 

20:1 

5 

SAVE, exec  :=  EXEC; 

961 

20:i 

8 

SAVE. I  :=  i; 

962 

2o:i 

11 

SAVE, J  :=  J! 

963 

2o:i 

14 

IF  EXEc^CJD  =  ESC  THEN  MACNUM  :=  1 

961 

20:1 

21 

ELSE  MacNUM  :=  OROCEXEC^CJD-ORDCOM; 

965 

2o:i 

33 

IF  (MACR0SCHACNUM],EXEC  =  NIL)  THEN 

966 

20:2 

t3 

BEGIN 

967 

20:3 

^+3 

WRITELN ( OUTPUT, ' ILLEGAL  MACRO. . .TRY 

968 

20:3 

81 

EXIT(COMMAND) 

969 

20:2 

88 

end; 

970 

20:1 

88 

IF  {MACNUM<0)  OR  (MACNUM  >  MAXMAC)  THEN 

971 

20:1 

100 

EXEC  :=  macros[:macnum],exec; 

972 

20:1 

108 

I  :=  macRoscmacnumd.i-gth; 

973 

20:1 

116 

WHILE  RCOUNT  >  0  DO 

97f 

20:2 

123 

BEGIN 

975 

20:3 

123 

RCOUNT  :=  RCOUNT  -1; 

976 

20:3 

131 

IF  COMMAND  THEN 

977 

2o:i 

137 

BEGIN 

978 

20:5 

137 

COMMAND  :=  TRUE; 

979 

20:5 

im 

EXIT(COMMAND) 

980 

20:'+ 

ms 

end; 

981 

20:3 

145 

ERROR  :=  (J<I); 

982 

20:3 

150 

IF  ERROR  THEN 

983 

2o:<4 

153 

3EGIi\l 

Ot^  if 


AGAIN*) ; 
SYNTAX! •«• ) 


9Ji+ 

1 

2e;  5 

1^)3 

^65 

1 

2b::^ 

1  j7 

36  a 

1 

^j:4 

l':"i; 

3rt7 

i 

2C:>: 

iVo 

■9  OH 

1 

2n:i 

1  =  7 

-J63 

1 

2  0 :  i 

lij 

990 

1 

20  :i 

193 

d^l 

1 

2o:i 

i3&. 

332 

1 

20:0 

205 

33  6 

1 

2j:u 

213 

99*+ 

1 

21  :u 

1 

9  95 

i 

21:.! 

0 

99S 

1 

2i:i 

0 

997 

1 

21:2 

,] 

993 

1 

21:3 

0 

999 

1 

21:3 

11 

lOOl) 

i 

21:4 

18 

iOOl 

1 

21:  3 

25 

1002 

1 

21:6 

62 

1003 

1 

21:5 

36 

1004 

1 

2i:b 

42 

1005 

1 

21:2 

50 

1006 

1 

21:0 

53 

10C7 

1 

2 1 :  Q 

q6 

1005 

1 

22:d 

1 

1009 

1 

22:j 

1 

1010 

1 

22:3 

1 

1011 

i 

22:.D 

2 

1012 

1 

22:  r^ 

0 

1013 

1 

22:1 

j 

1014 

1 

22;i 

5 

1015 

1 

22:1 

15 

1016 

■1 

22:2 

24 

1017 

1 

22:3 

24 

101a 

1 

22;  3 

29 

1019 

1 

22:3 

37 

102G 

i 

22:3 

46 

1021 

1 

22:'+ 

52 

1022 

X 

22:5 

o2 

1023 

1 

22:4 

b4 

x02'+ 

1 

22:5 

64 

KcojijT  :=  c; 

WRITZL.J(OiJTPl-'T,  ♦WACKO  HALTED  '  )  ; 

ci  'vi  D ; 

cTXEC    :=    S1\\Jl,CkZC; 

I    :=  Sfu'E.i; 
J   :=  SAvZ.j; 

IF    H-R-^OR    Then    EXITCCOMMAND)  ; 
"'^D     (♦    '^Jow    EXECUTE    i^ACKO    *); 

-ROCEDUR-:    OPTIO'i-103; 
JtGI  \l 

ifliiTH  Option  00 

BEGl^j 

OiOFF    :=    NOT    ONUFF; 
IF    O.nIOFF    THEN 

WITH  SYSCOM'^,CRTIr,jFO  DO 
IF  KCOJNT  >  1  THEN 

LisTsiZE  :=  Rcourn 

ELSE 

LISTSIZE  :=  HEIGHT  DIV  2  -1 

END 
ENO; 

PROCEDURE  READFILE; 
\/AR 

lgth:  integer; 

title:    STRINGC400; 

liEGlN 

J   :=  J  +i; 

lgth    :=    SCAN(30,=EsC»EXEC'"CuJ)  ; 
IF     (LGTH    <=    30)    AND    (LGTH    >    0)     Tf^EN 
BEGIN 

TlTLECOl    :=    CHR(LGTH) ; 
M0\/ELEFT(EXEC-CJ3,TITLEC1D.LGTH)  5 
OPEr^OLDdOFILE, TITLE)  ; 
IF    IORlSULT    =    Q    THEN 

^EGIN    IF    NEWFIN    THEN    EXI T  (  CQiviMAND )    END 
ELSl 
3EGIN 

0PEN0LD(I0FILE,C0NCAT( TITLE, '.TEXT* )); 
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J.  a  <  '•' 

i 

22: -> 

'.'  "J 

xJ2o 

1 

22 ;  o 

1 :  t 

xQ2  7 

't 

22  :d 

il't 

l'Jd;i 

X 

22  :f, 

us 

102  9 

1 

2217 

ixo 

1330 

J. 

2>:7 

13] 

lOiJ. 

i 

22:6 

13h 

iO:)2 

1 

2dli4 

i'il 

1033 

1 

22:2 

I'jl 

10  34 

X 

22:1 

101 

1035 

1 

22:2 

160 

1036 

1 

22:3 

106 

1037 

1 

22:3 

213 

103b 

1 

22:2 

222 

1039 

1 

22:1 

222 

1010 

1 

22:0 

227 

LOfl 

1 

22:0 

212 

1042 

1 

23  :d 

1 

iO'+3 

1 

23:d 

1 

lO'+l 

1 

23:d 

1 

lO'+S 

1 

23:o 

u 

lo'+a 

1 

23:i 

0 

lo^y 

1 

23:1 

7 

1043 

1 

23:2 

11 

1019 

1 

23:i 

15 

1050 

1 

23:2 

21 

1051 

1 

23:i 

2b 

10  52 

1 

23:i 

31 

1053 

1 

23:2 

3d 

1054 

1 

23:3 

36 

1055 

1 

23:3 

39 

1056 

1 

23:3 

bl 

1057 

1 

23:2 

85 

1058 

1 

23:1 

6  5 

1059 

1 

23:2 

92 

10£»u 

1 

23:i 

99 

1061 

1 

25:2 

101 

105.2 

1 

23:0 

lOfl 

1063 

1 

23  :g 

120 

1061 

1 

21  :d 

1 

1065 

1 

21  :d 

1 

IF     lORF  SUt.T    =    0     THE; J 

,.5L'Gi'J  IF  >je;wfin  Then  exit {Com'«'! and)   end 

L  L  S  C 
,  E  G I  '-J 

'.-JRirE^  MUUTPUT, 'FIlE:     ', title,'     is    in    error.       mot    READ'); 

ex  it (command)  ! 
end; 

CN3 
END 
ELSE 
3EGIN 

ft'rtteln(output, 'file  name  error.'); 
exit (command) ; 

end; 

J  :=  J  +LGTH; 

end; 

procedure  save; 

VAR 

PCS, delta:  INTEGER; 

3EGIN 

LINEPLACE(POS,RC0tJNT)  ; 
IF    RCOunT    <=    0    THEN 

DELTA  :=  CURSOR  -POS 
ELSE 

DELTA  :=  POS  -CURSOR; 
BUFEND  :=  3UFSIZE  -DtLTA; 
IF  SUFenD  <=  ENDPGS  THEN 

BEGIN 

BUFEND  :=  SUFSIZL; 

writelnc output, 'nut  enough  room  to  save  in'); 
exit (command) ; 
end; 
if  rcoj^•t  <=  0  then 

^lO  VELEFT  (eUF-^C  POS  a  »BUF'*C  BUFEND  D.DELTA) 
ELSE 

MO  VE._EFT{BUF'"CC;JRS0R],BUF'^C3dFEND  D.DELTA) 

END  (♦  Save  ♦) ; 

PROCEDURE  UNSAVE; 
VAR 
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i  U  O  '^ 

1 

24  :t 

i 

lQo7 

1 

24  :u 

•) 

I  u  6  B 

1 

L"- :  1 

,  ; 

10  69 

1 

c:^:^ 

7 

1070 

1 

24:  i 

7 

1071 

i 

24:2 

12 

1072 

1 

24:3 

12 

i07i 

1 

24:5 

17 

1074 

1 

24:3 

22 

1075 

1 

2'+:3 

27 

107S 

■? 

24:4 

3  4 

1077 

1 

24:5 

o4 

1073 

1 

24:5 

tl 

1079 

1 

24:5 

43 

ioao 

1 

24:5 

53 

1031 

1 

24:4 

56 

1032 

1 

24:3 

57 

1033 

1 

24:4 

59 

lOd^ 

1 

24:2 

95 

1065 

1 

24:o 

95 

1086 

1 

24  :o 

103 

1037 

1 

25:d 

1 

10  33 

1 

25:o 

0 

106':? 

1 

25  :i 

0 

1090 

1 

25:i 

6 

1091 

1 

25  :o 

10 

1092 

1 

25:o 

24 

1093 

1 

26;d 

1 

1094 

1 

26  :d 

1 

10  95 

1 

26:j 

1 

109b 

1 

26:o 

2 

1097 

1 

26:o 

0 

1093 

1 

26:i 

0 

1099 

1 

26:i 

5 

1100 

1 

26:i 

15 

1101 

1 

26:3 

24 

11U2 

1 

26:3 

29 

1103 

1 

26:3 

37 

1104 

1 

26:3 

50 

1105 

1 

26:4 

73 

1106 

X 

26:3 

101 

STASH?IZE.3T;•\5f^EQAT1tJE:LTA:     irJTrSFK; 

IF    KCUj-.jT    =    D    TiiLj 

:iJFL:j:i     :=    4;UF3IZC 
ELSE 
BEGTj 

STASHSI2E    :=    EijDPOS    -CURSOR; 
DELTA    :=    BUFSI7E    -BUFEND; 
STasHEDAT    :=    cursor    +DELT'^; 

IF     ((STASHEDAT    +bTASHSlZE)    <    BUFENQ)     THEI^ 
3EGIIJ 

MOVERISHKbUF-CCURSORJ.dUF-rSTASHEDATJ.STASHSiZE); 
MO\/ELEFT  OUF'^CBUFEND  3,  8  JF'^C  CURSOR  D,  DELTA); 
ENOPOS    :=    EiMDPOS    +DELTA; 

BUF'^EEfJDPOs:    :=    CHR(O) 

emo 

ELSE 

5EGIN  WRITELM(0UTPUTiTJ3T  ENOUGH  SPACE');  EXIT( COMMAND)  END 
END  (*  '^  =  0  *) 
END  {♦  UrJSAVE  *)  ; 

PROCEDURE  VIEW; 
3  EG  IN 

RCOUNT  :=  o;   LIST; 
RCOUNT  :=  l;   LIST 

END; 

PROCEDURE    kJRiTEFILE; 
\/AR 

LGTH:  INTEGER; 
title:  STRINGC40J; 

BEGIN 

J  :=  J  +i; 

LGTH  :=  SCAN(30i=ESC.EXEC'^CjJ)  ; 
IF  (LGTH  >  0)  AND  (LGTH  <=  30)  THEN  BEGIN 
TITLEC03  :=  CHR(LGTH) ; 

M0\/ElEFT(EXEC'^CJ],TITLEC1D,LGTH)  ; 

IF  (TITLECLGTHII  <>  «,♦)  AND  (TITLECLGTHJ  <>  •]')  AND 
(POSC. TEXT', TITLE)  =  0)  THEN 
TITLE  :=  CONCAT(TITLE,',TEXT') ; 
IF  (TITLECLGTH]  =  '.•)  THEN  DELETE ( TITLE , LGTH . 1 ) ; 
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1107 

1 

2b 

:  i> 

116 

1 1 J  'j 

i 

26 

:6 

125 

iiJi 

1 

25 

:i 

i  ji 

1110 

1 

2b 

1 J 

1 .5  1 

lili 

1 

2b 

:  D 

135 

1112 

1 

2b 

:5 

211 

1115 

1 

26 

;i 

21d 

1111+ 

1 

26 

;2 

21  S 

1115 

1 

26 

:3 

220 

1116 

1 

26 

:3 

219 

1117 

1 

26 

;2 

253 

1118 

1 

26 

;i 

253 

1119 

1 

26 

0 

25^ 

1120 

1 

26 

;o 

272 

1121 

1 

2 

>  0 

0 

1122 

1 

2 

1 

0 

1123 

1 

2 

1 

3 

1121 

1 

2, 

1 

21 

1125 

1 

2; 

1 

21 

1126 

1 

2; 

2 

29 

1127 

1 

2! 

3 

29 

1128 

1 

2; 

1 

57 

1129 

1 

2; 

3 

61 

1130 

1 

2: 

3 

69 

1131 

1 

2: 

3 

71 

1132 

1 

2! 

1 

98 

1133 

1 

2; 

5 

33 

1131 

1 

2; 

5 

93 

1135 

1 

2: 

1 

95 

1136 

1 

2; 

3 

9y 

1137 

1 

2; 

1 

107 

1133 

1 

2: 

5 

107 

1139 

1 

2. 

5 

110 

lilO 

1 

2. 

6 

110 

1111 

1 

2: 

6 

121 

1112 

1 

2. 

0 

121 

1113 

1 

2: 

5 

111 

illl 

1 

2; 

1 

119 

HI'S 

1 

2: 

3 

119 

Ills 

1 

2: 

3 

151 

1117 

1 

2: 

1 

17U 

UP£;^J:iE:^'(  lOriLtli  TITLE)  ; 
IF  lORtSULT  =  0  THLN 

'Jl/.GJTlGO^ 
ELSE     'i^GlU 

/jKITEL, ^{OUTPUT, COrJCAK 'FILE:     '.TITLEt'     IS    IN    ERROR.    WRITE    NOT    DONE.' 

rXlT(CO.""lMA?jQ)  ; 

EfjLi; 

END  ELSE  3EGIN 

■WRITILN(0UTPJT,  'ILLEGAL  TITLE*  )  ; 

EXXT(c0^f'•1Ar^iD)  ; 
END; 

J  :=  J  +LGTH; 
end: 

BEGIN     (*CO'^MAND*) 
COMMAND    :=    FALSE; 
NUf>1BER    :=    C*Q*  ..'  3'2l 
J    ;=    0; 

WHILE    (J<I)    DO 
BEGlr^ 

-\iHlLE    (EXECCJ]    IN    C*     '  t  ACR  ,  CHR  (  TAB)  »  ESC  3  )    AND    (J<I)    DO 

J  :=  SUCC(J) ; 
THisCH  :=  EXEC^CJ]; 
NEg  :=  (THISCH  =  •-') ; 
IF  THISCH  IN  C'+'»'-*3  THEN 
BEGIN 

J  :=  J  +1; 

thisch  :=  exec'cjd 

en3; 

if  (thisch  in  number)  then 

3EGIN 

RCOUNT  :=  0  5 
REPEAT 

RCOUMT  :=  (RCOUNT*10)  +  ORD  (  EXECC  J3 ) -ORD  (  *  0  *  )  ! 

J  :=  succ(J) 

UNTIL  {(NOT  (EXEC^CJD  IN  NUMBER))  OR  (RCOUNT  >  3200)); 

THISCH  :=  execcj:; 

EnU(*  IN  NUr^BEK  *) 
ELSE  RCOUNT  :=  15 
IF  (THISCH  IN  C'='i'/'J)  THEN 

IF  (RCOUfJT  <>  1)  THEN  SYNTAX  ( THISCH ) 
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ima 

1 

2:-'f 

17i 

11H9 

1 

2:5 

IfiQ 

1150 

1 

t^:o 

IdU 

1151 

1 

2:6 

185 

115-^ 

1 

2:s 

196 

1155 

1 

2:& 

201 

ilSH 

1 

2:5 

203 

1155 

1 

2:3 

20b 

1156 

1 

2:5 

213 

1157 

1 

2:3 

222 

1153 

1 

2m 

2Ho 

115^ 

1 

2:i+ 

2^-9 

1160 

1 

2:*+ 

253 

1161 

1 

2:4 

26U 

1162 

1 

2m- 

265 

1165 

X 

2:^ 

271 

116'+ 

1 

2m- 

275 

1165 

1 

2m 

280 

1166 

1 

2  m 

284 

1167 

1 

2:4 

315 

1166 

1 

2:^ 

319 

1169 

1 

2m 

323 

1170 

1 

2m 

527 

1171 

1 

2:^+ 

331 

1172 

1 

2:1 

335 

1173 

1 

2m 

339 

117^+ 

1 

2m 

343 

1175 

1 

2:'+ 

343 

117b 

1 

2m 

343 

1177 

1 

2:6 

348 

1178 

1 

2:0 

355 

1179 

1 

2:6 

559 

1160 

1 

2:6 

332 

1181 

i 

2:5 

586 

1182 

1 

2m 

338 

1135 

1 

2'm 

392 

1184 

1 

2:4 

396 

1135 

1 

2:^+ 

4no 

1186 

1 

2:h 

4ij4 

1197 

1 

2:'+ 

^08 

1188 

1 

2:4 

412 

IF 
IF 
IF 


:lSl 

BEG 

I 

J 

T 

END 

WEG 

(J  > 

(THI 

;ase 
1 71 

•A« 
•3« 
•C« 
'D» 
♦E' 
•G» 
•H» 
•I' 
•J» 
•K» 
•L« 
•M« 
•N» 
•0' 
ipi 

»pt 
•Q» 


lU 

F  (ffilSCH  =  •  =  •)  THEf'J  RCOUNT  :  = 

LSE  (*  -     •/•  *)  RCOJNT  :=  32700; 

:=  J  +1 ; 

HISCfH    :=    EXEC^CJD 


■EQUALLENGTH 


THEN 


THETJ    RCCUNT    ;=    -RCOUNT; 

=  I)  THEN  EXIT(COMMAND) ; 

SCH  IN  C '?'i •A«..'Z», •A'..'Z':) 

thisch  of 

:  Prompts; 

:LlNEPLACE(CURSOR,RCOUf\iT)  ; 

:cur50r:=o;  {*da  end*) 

:begin  deletestuff;  inserttext  end; 

:deletestuff; 

:cleahscreen; 

»  'F'.'G'cGETTER; 

:WRITELN(0UTPUT,  •  uniwiplemented  '  )  ; 
:     IrjSERTTEXT; 

:J'Jhp; 

:kill; 

:list; 

:  'jiachodefinition; 

:  nowexecutemacro; 

:  optionmod; 

. ♦ . • 7» 


•R» 

•S' 
•U» 
•  VI 

•x» 


•A 
•S 

•c 

♦D 
»E 
•F 
•H 
•I 
•J 
•K 
•L 
»iM 
•N 
•0 
•T 
•T 


SYNTAX(THISCH) ; 


ZhO 


BEGIN 

THISCH  :=  EXEC^Cwi  +  i:; 
CLOSETHEWORLD(THISCH) ; 
COMMAND  :=  (THISCH  IN  C • E • 1 • E • , • U» , 'U • : ) ; 

EXIT(COMMAND) 

END; 

•r»:readfile5 
•s' :save; 
•u«  :UijsAVE; 

•V»:VIEW5 
•W»:wRlTLFlLE; 

•x':3EGiN  kill;  inserttext  end 
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O  "^  '^ 


1139  i  2:6  54?  LUiE    SYi^TAX(THlSCH)  ; 

ii'^'O  i  2:5  J'^7  j:=j+l; 

ll'?!  1  2:2  532  EWC    (*    .-JHILE    J    <=    I    *); 

ll^i  i  2:1  ^^4  IF    OPTION.  DTJOFr    THfii 

U93  1  c::^  561  rSEGlj 

1194  1  <i:i,  ooi  CL£A'^SCrtEE.'Ji 

ll'^5  1  2:i  5oH  RCOU'n    ;=    -OPTION. IISTSIZE; 

119^  1  2:3  57?  i.l3T; 

1197  1  2:6  57'+  WRITE(  OUTPUT,  CHR<  10  (*  LF  *))); 

1198  i  2:3  5d2  RCdU'JT  :=  OPT  IOf\' .  LISTSI  ?E ; 
1139  1  2:6  589  LIST 

1200  1  2:2  od?  EiJQ; 

1201  1  2:3  591  fHD    (*    COi^MAfJD    *); 

1202  1  2:j  618 

12G3  1  l:c  0  bEIGIN    (*YALOl*) 

120'+  1  1:1  0  INITIALIZE: 

1205  1  1:1  14  REPEAT 

1206  1  1:2  14  rtRlTr(KEYBOARO,  •*•  )  ;     (*CLEARS    '^F    AND    '^S    FLAGS!*) 

1207  1  1:2  22  (*            THIS    LIME    IS    FOR    THE    HAVAHEART    COMMAND 

1203  1  1:2  22  *      M0\/EL£FT(EXEC''i3UF''CENDP0S  +  i:f  i^INdtBUFEND-ENDPOS)  )  ; 

1209  1  1:2  22  *  WHICH    SOME    DAY    MAY    BE    I^IPLEMENTEO    ♦) 

1210  1  1:2  22  INC0;MMAND 

1211  1  1:1  22  UNTIL    CO^i^AND; 

1212  1  1:0  30  end; 

1213  1  1:0  50 

1214  0  1:0  0  sEGIf^J    (*    JUST    A    DUMMY    *) 
121b  0  1:0  0  E'^ID. 
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If 
15 
16 
17 
18 
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20 
21 
22 
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2"+ 
25 
26 
27 
28 
29 
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31 
32 
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3tf 
35 
36 
37 
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39 
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1 

1 

1 

1 

1 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 
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0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 

0 
0 
0 
0 
0 
0 
0 
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i:d 
l.-J 

1:3 
i:j 
i:d 


1 

1: 

1: 

1: 

1: 

1: 

1: 


:d 
D 
3 
0 
0 

D 
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i:d 

i:d 

i:d 

i:d 

i:d 

1:0 

i:d 

i:d 

i:d 

i:d 

i:d 
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i:d 

i:d 

i:d 

i:d 
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1:0 

i:d 

i:d 
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i:d 

1:0 
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i;d 
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1 
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1 

1 
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(*iL 

(*  SW 

(*$C 

(*ST+ 

{♦$1 

(*$U- 

PROGR 


(* 
(  * 
(  * 
(* 
(* 
(« 

(♦ 
(  'I' 
<  * 

(  * 
(  * 
(  * 
(* 
(  * 

(♦ 

(* 

{* 
{* 

{* 
(  ♦ 
{  **** 

TYPE 
INFOR 
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1.5  SEPTEMBER,  1978 

II. 0  JANUARY,  1979 

INSTITUTE  FOR  INFORMATION  SYSTEMS 
UC  SAN  DIEGO,  LA  JOLLA,  CA  92093 

KENNETH  L.  BOi«IlES,  DIRECTOR 

COPYRIGHT  (C)  1979,  REGENTS  OF  THE 
UNIVERSITY  OF  CALIFORNIA,  SAN  DIEGO 
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*) 
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*) 
*) 
*) 
*) 
*) 


***************^;^***^^^^^^^^^^^^^^^^^^^ 
PHYLE  =  file; 

ec  =  record 

worksym,workcode:  '^phyle; 
errsym,errblk,errnum:  integer; 
slowterm, stupid:  boolean; 
altmode:  char 
end; 
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SEGMENT  PROCEDURE  USERf^ROGRAM ; 

SEGMENT  PROCEDURE  FiLEHANDLER ; 
BEGIN  END; 

SEGMENT  PROCEDURE  DEBUGGER; 
BEGIN  END; 

SEGMENT  PROCEDURE  pRiNTERROR; 
BEGIN  END; 

SEGMENT  PROCEDURE  INITIALIZE? 
BEGIN  END; 

SEGMENT  PROCEDURE  GETCMD; 
BEGIN  END; 

SEGMENT  PROCEDURE  NOTUSEDi; 
BEGIN  END; 

SEGMENT  PROCEDURE  N0TUSED2; 
BEGIN  end; 

SEGMENT  PROCEDURE  N0TUSED3; 
BEGIN  END; 

BEGIN  END;  (*  USERPROGRAM  *) 

SEGMENT  PROCEDURE  PASCALCOMPILER ( VAR  USERINFO:  INFOREC); 

CONST  DISPLIMIT  =  12;  MAXLEVEL  =  8;  MAXADDR  =  28000; 
INTSIZE  =  l;  REALSIZE  =  2;  BITSPERWD  =  16? 

charsize  =  i;  BOOLsiZE  =  i;  ptrsize  =  i; 

FILESIZE  =  300;  NILFILESIZE  =  40;  BITSPERCHR  =  8?  CHRSPERWD  =  25 
STRINGSIZE  =  0;  STRGLGTH  =  255;  MAXINT  =  32767;  MAXDEC  =  36; 
DEFSTRGLGTH  =  80!  LCAFTER^ARKSTACK  =  1;  REFSPERBLK  =  128; 
EOl  =  13;  MAXCURSOR  =  1023;  MAXCODE  =  1299; 
MAxjTAB  =  24;  MAXSEG  =  15;  MAXPROCNUM  =  149; 
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(♦BASIC  SYMBOLS,  ^^UST  MflTCH  ORDER  IN  IDSEARCH*) 

SYMBOL  =   (lOErgi.  COMMA,  COLON,  SEMICOLON,  LPARENT,RPARENT,D0SY,TOSY» 

OOWNTOSY,EMDSY, 'JrJTlLSY,OFSY,THENSY,ELSESY, BECOMES, LBRACK, 

rno2^'^u'^^^^°'''^^'^^°°'^^'^^^S^'I''SY»CASESY,REPEATSY,WHlLESY, 

F0RSY»WITHSY,S0TDSY,LA8ELSY,C0!\JSTSY,TYPESY,VARSY,PR0CSY, 

FUNCS  Y,  PROGS  Y,F0R^.ARDSY,INTC0NST,REALC0NST,STRINGC0NST, 

NOTSY.MULOP,ADOOP,RELOP,SETSY,PACKEDSY,ARRAYSY,RECORDSY, 

FlLESY.OTHERSY,LONGCONST,USESSY,UNITSY,INTERSY,IMPLESY, 
EXTERNLSY,SEPARATSY);  ♦  x  ^"  crtoi ,  xr-iKLtbT  , 

OPERATOR  =  (MUL,RDIV,ANDOP,IDIV,IM0D,PLUSiMlNUS,OROP,LTOP,LEOPt 
GE0P,GT0P,NE0P,EQ0P,IN0P,N00P) ; 

SETOFSYS  =  SET  OF  SYMBOL; 

NONRESIDENT  =  ( SEEK, FREADREAL , FWRITEREAL,FREADDEC.FWRITEDEC,DECOPS) • 
NONRESPFLIST  =  aRRAYCNONRESIDENT]  OF  INTEGER;   '"'- "^'^'^^  "^'^'^^ '""^^OPS)  , 

CSTclASS  =  (REEL. HSET»STRG,TRIX, LONG)!     *^  NSTANTS*) 

CSP  =  '^  CONSTREC; 

CONSTREC  =  RECORD  CASE  CCLASS:  CSTCLASS  OF 

LONG:  (lleng.llast:  integer; 

LONGVAL:  ARRAYC1..93  OF  INTEGER); 

trix:  (cstval:  array  cl.s:]  of  integer); 

(♦MUST  COMPLETELY  OVERLAP  FOLLOWING  FIELDS*) 

reel:  (rval:  read; 

PSET:  (PVAl:  set  of  0..127); 

STRG:  (slgth:  cstrglgth; 

SVAL:  packed  array  C1..STRGLGTH3  of  CHAR) 

end; 

valu  =  record  case  boolean  of 

TRUE:  (ival:  integer); 
false:  (valp:  csp) 

end; 

(*data  structures*) 
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BITRaNGl  =  0..3lTi>P£:RWD;  OPRANGE  =  0,.80; 
CURSRANGE  =  0 . .mAXCURSOR ;  PROCRANGE  =  0 . .MAXPROCNUM ; 
LEVRANGE  =  0..?^AXLEVEL;  ADORRANGE  =  O..MAXADDR; 
JTA3RANGE  =  0.,MAXJTAB;  SEGRANGE  =  O..MAXSEG; 
DISpRAiJGE  =  O..DISPLIMIT; 

STRUCTFORM  =  ( SCALAR , SUBRANGE ♦ POINTER tLONGiNT . POWER t ARRAYS . 
RECORDS»FlLES,TAGFLDf VARIANT) ; 

DECLKIND  =  (STANDARD, DECLAREDiSPEClAL) ! 

STP  =  '"  structure;  CTP  =  "  IDENTIFIER? 


330 


STRUCTURE  = 


RECORD 

size:  addrr 
CASE  form: 
scalar: 

subrange: 
pointer: 
power: 
arrays: 


records: 
files: 
tagfld: 
variant: 

END! 


ANGE! 

structform  of 

(CASE  SCALKIND:  DECLKIND  OF 

declared:  (FCOnst:  ctp)); 
(rangetype:  stp;  min»max:  valu); 
(eltype:  STP); 
(elset:  STP); 
(aeltype.inxtype:  stp; 
CASE  aispackd:boolean  of 

true:  (ELSPERWDtELWIDTH:  BITRANGE; 

CASE  aisstrng:  boolean  of 
true:(maxleng:  l.strglgth) )) ; 
(fstfld:  ctp;  recvar:  stp); 

(FILTYPE:  STP); 

(Tagfieldp:  ctp;  fstvar:  stp); 
(nxtvaRiSubvar:  stp;  varval:  valu) 


IDClaSS  =  (TYPEStKONST,FORMALVARS»ACTUALVARS, field. 

PROC.FUNCtMODULE) ; 
SETOFIDS  =  SET  OF  IDCLASS; 
IDKirjD  =  (ACTUALtFORMAL)  ; 
ALPHA  =  PACKED  ARRAY  C1..83  OF  CHAR; 

IDENTIFIER  =  RECORD 

name:  alpha;  llink,  rlink:  ctp; 


(♦NAMES*) 
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idtype:  stp;  next:  ctp; 

CASE  KLASS:  IDCLASS  OF 

konst:  (values:  valu); 


FORiVlALVARSf 
ACTUALVARS: 


field: 


PROC, 
FUNC: 


MODULE: 

end; 


(^lev:  levrange; 
vaddr:  addrraimge; 
case  300lean  of 

TRUE:  (PUBLIC:  BOOLEAN)); 

(fldador:  addrrange; 
CASE  fispackd:  boolean  of 

TRUE:  (FLDRBIT.FLDWIDTH:  BITRANGE)); 

(CASE  pfdeckind:  declkind  of 
special:  (KEY:  integer)? 
standard:  (cspnum:  integer)} 
declared:  (pflev:  levrange; 

pfname:  procrange; 

pfseg:  SEGRANGE; 

CASE  pfkino:  idkind  of 

ACTUAL:  (LOCALLC:  ADDRRANGE! 

forwdecl:  boolean; 
exturnal:  boolean; 
inscope:  boolean; 

CASE  boolean  of 

,„^^^         true:  (imported:boolean)))); 

INTEGER) 


(Segid: 


WHERE  =  (BLCK,CREC,VREC,REC); 

ATTrkIND  =  (CST,VARBLfEXPR); 

VACCESS  =  (DRCT,INDRCT,PACKD»MULTI»BYTE); 


(♦EXPRESSIONS*) 


ATTr  =  RECORD  TyPTR:  STP; 

CASE  kind:  ATTRKIND  OF 

cst:   (cval:  valu); 

varbl:  (CASE  access:  vaccess  of 

drct:   (vlevel:  levrange;  dplmt: 
indrct:  (idplmt:  addrrange)) 


ADDRRANGE) ; 
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end; 

TEISTP    =    '^    TtSTPOlf^tTERJ 
TESTPOIivlTER    =    RECORD 

ELT1,ELT2 

lasttestr 
end; 


STP; 

TESTP 


(♦LABELS*) 

LBP  =  '"  codelabel; 

CODelABEL  =  RECORD 

casl  defined:  boolean  of 
false:  (reflist:  addrrange); 
true:  (occuric:  addrrange;  jtabinx:  jtabrange) 

END; 

LABELP  =  '*  USERLABEL; 
USErlABEL  =  RECORD 

labval:  integer; 
nextlab:  labelp; 

CODELBP:  LBP 
END; 

REFARRAY  =  ARRAYC1..REFSPERBLK3  OF 
RECORD 

keytoffset:  integer 

end; 

CODEARRAY  =  PACKED  ARRAY  C0.,MAXCODEJ  OF  CHAR; 
SYM3UFARRAY  =  PACKED  ARRAY  CCURSRANGE3  OF  CHAR; 

UNITFILE  =  (WORKCODE.SYSLIBRARY); 

LEXSTKREC  =  RECORD 

DOLDTOP:  disprange; 
doldlev:  0..maxlevel; 
poldproc.soldproc:  procrange; 
doldseg:  segrange; 
DLLC:  addrrange; 
3FST:  symbol; 
dfprocp:  CTP; 
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OMAf<KP:    "INTEISER; 

issegment:  boolean; 
prevlexstackp:  '^lexstkrec 

END; 


codep:  ^  codearray; 
SYNiauFP:  ^   symbufakray; 

gattr:  attr; 
top:  disprange? 

LCtIC:    AODRRAIMGE; 

TEST:  boolean; 
intptr:  stp; 
seg:  segrange; 


symcursor:  cursrange; 
sy:  symbol; 
op:  operator; 
id:  alpha; 

lgth:  integer; 


val:  valu; 
disx:  disprange; 

LCMAx:  ADDRRANGE; 


•*) 


(*CODE  BUFFER  UNTIL  WRITEOUT*) 
(♦SYMBOLIC  BUFFER. ..ASCII  OR  CODED*) 

(♦DESCRIBES  CURRENT  EXPRESSION*) 

(♦TOP  OF  DISPLAY*) 

{♦LOCATION  AND  INSTRUCT  COUNTERS*) 

(*P0INTER  TO  STANDARD  INTEGER  TYPE*) 
(♦CURRENT  SEGMENT  NO.^) 
(♦SCANNER  GL0BALS..,NEXT  FOUR  VARS*) 
{♦MUST  BE  IN  THIS  ORDER  FOR  IDSEARCH*) 
(♦CURRENT  SCANNING  INDEX  IN  SYMBUFP*^) 
(♦SYMBOL  FOUND  BY  INSYMBOL+) 
(♦CLASSIFICATION  OF  LAST  SYMBOL^) 
(♦LAST  IDENTIFIER  FOUNDS) 

(♦LENGTH  OF  LAST  STRING  CONSTANT  IN  CHARS 
OR  LEN  OF  LAST  LONG  INTEGER  CONSTANT 
In  DIGITS^) 

(♦value  of  last  constant^) 
(♦level  of  last  id  searched^) 

{♦temporaries  location  counters) 

(♦switches:^) 


PRTERR,G0T00K»RANGECHECK. DEBUGGING* 

noisy,codeinseg,iocheck,bptonline, 

CLINKERINFCDLINKERINFO,  list,  TINY  aSEPPROC* 
OP, INCLUDING, US I NGtNOSWAPtSEPPROC, 
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STARTlNGUP,INM0DULL,INir\JTERFACEfFLIP3YTESt 
LI3N0T0PEN,SYSC3MP.PUBLICPR0CS.GETSTMTLEV:    BOOLEAN  5 
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(*IIMTPTRt*)REALPTRtLONGINTPTR, 

CHARpTRtBOOLPTR, 

TEXTPTRiNILPTK* 

Iimtractvptr,strgptk:  stp; 

UTYPPTRiUCSTPTRtUVARPTRf 

ufldptr.uprcptr.ufctptr. 
wodptr.inputptr.outputptr, 
outerbI-ock,fwptr,usinglist:  CTP; 

globtestp:  TESTP; 

level:  LEVRANGE; 
BEGSTMTLEV.STMTLEV:  INTEGER? 
MARKP:  '^INTEGER; 

tos:  '^lexstkrec; 
glev:  disprange; 
newblock:  boolean; 

nextseg:  segrange; 
seginx:  integer; 
sconst:  csp; 
strgcstic:  aodrrange; 


(♦pointers:*) 

(♦pointers  to  standard  ids*) 
(♦pointers  to  undeclared  ids*) 

(♦LAST  TESTPOINTER*) 

{♦CURRENT  STATIC  LEVEL*) 

(♦CURRENT  STATEMENT  NESTING  LEVEL*) 

(♦FOR  MARKING  HEAP*) 

(*T0P  OF  LEX  STACK*) 

(♦GLOBAL  LEVEL  OF  DISPLAY*) 

(♦INDICATES  NEED  TO  PUSH  LEX  STACKS) 

(♦NEXT  SEGMENT  #♦) 
(♦CURRENT  INDEX  IN  SEGMENT^) 
(♦INSYMBOL  STRING  RESULTS^) 
(♦AODR  OF  LAST  STRING  IN  CODE^) 


lowtlmeflineinfo,screendotststartdots.symblk,smallestspace:  integer; 
linestart:  cursrange; 


CURPROCtNEXTPROC:  PROCRaNGE; 


(♦PROCEDURE  NUMBER  ASSIGNMENT*) 


CONSTBEGSYStSIMPTYPEBEGSYSfTYPEBEGSYSi 
BLOCKBEGSYS»SELEcTSYS,FACBEGSYS,STATBEGSYSiTYPE0ELS:  SETOFSYS; 

VARS:  setofids; 

display:  ARRAY  CDISPRANGE3  OF 
RECORD 

fname:  ctp; 

case  occur:  where  of 
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10 

i;d 

26 

529 

10 

i:.j 

26 

330 

10 

ll'J 

26 

331 

10 

i:  J 

26 

332 

10 

i:o 

78 

333 

10 

i:o 

78 

334 

10 

i:d 

84 

335 

10 

i:d 

84 

336 

10 

i:d 

34 

337 

10 

i:d 

34 

338 

10 

i:u 

34 

339 

10 

i:d 

34 

340 

10 

i:d 

34 

341 

10 

i:d 

34 

3«f2 

10 

i:d 

34 

343 

10 

i:d 

31 

3ff 

10 

i;d 

62 

345 

10 

i:d 

62 

346 

10 

i:d 

63 

347 

10 

i:d 

84 

348 

10 

i:d 

35 

349 

10 

i:d 

10 

350 

10 

i:d 

10 

351 

10 

i:d 

50 

352 

10 

i:d 

52 

353 

10 

i:d 

53 

354 

10 

i:d 

55 

355 

10 

i:d 

59 

356 

10 

i:d 

60 

357 

10 

i:d 

40 

358 

10 

i:o 

41 

359 

10 

i:d 

41 

360 

10 

i:d 

43 

361 

10 

i:d 

1  99 

362 

10 

i:d 

1  99 

363 

10 

i:o 

1  99 

364 

10 

i:d 

1  99 

365 

10 

i:d 

1  99 

366 

10 

2:d 

1 

367 

10 

2:0 

2 

368 

10 

3:d 

1 

blck:  (ffile::  ctp;  flabel:  labelp); 
cREc:  <CLE\/:  levkange;  cdspl:  addrrange); 
vRE-c:  (vospl:  addrrangE) 

END  ; 
pfmuviof:  NONRESPfUST; 
PROCTABLE:  array  CPROCRANGED  of  INTEGER; 

segtable:  array  csegrange:  of 

RECORD 

DiSKADDRtCODELENG:  INTEGER; 

segname:  alpha; 

SEGKIND, 

TEXTADDr:  INTEGER 
END  (*SEGTABLE*)  ; 

comment:  '^STRING; 

systemlib:  stringc^od; 

NEXTJTAB:  JTABRANGE; 

jta3:  array  cjtabranged  of  integer; 

Reffile:  file; 
nrefstrefblk:  integer; 
reflist:  ^refarray; 
oldsymblkfprevsymblk:  integer; 

oldsymcursor,oldlinestart,prevsymcursor,prevlinestart:  cursrange; 
usefile:  unitfile; 

iNCLFlLEfLIBRARY:  FILE; 
LP:  TEXT; 

CURBYTE,  CURBLK:  INTEGER; 

DISKbuF:  PACKED  ARRAY  CO. .5113  OF  CHAR; 


(*" 


*) 

1  99  (*  FORWARD  DECLARED  PROCEDURES  NEEDED  BY  COMPINIT  *) 

1  PROCEDURE  ERRORCERRORNUM:  INTEGER); 

FORWARD; 
1  PROCEDURE  GETNEXTPAGE; 
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3S9 

10 

3:3 

370 

10 

i:d 

371 

10 

i:d 

372 

10 

5:d 

373 

10 

5:o 

37^ 

10 

6:d 

375 

10 

6:d 

376 

10 

6:o 

377 

10 

&:d 

378 

10 

6:d 

379 

10 

7;d 

380 

10 

7;d 

381 

10 

8:d 

382 

10 

8:d 

383 

10 

9:d 

381 

10 

9:d 

385 

10 

io:d 

386 

10 

io:d 

387 

10 

ii:d 

388 

10 

ii:d 

389 

10 

12:d 

390 

10 

12  :d 

391 

10 

13  :d 

392 

10 

i3:d 

393 

10 

ii:d 

39tf 

10 

ii:d 

395 

10 

15:d 

396 

10 

15:d 

397 

10 

i6:o 

398 

10 

16:d 

399 

10 

17:d 

too 

10 

i7:o 

IQl 

10 

18  :d 

t02 

10 

18ID 

103 

10 

19:d 

101 

10 

i9:d 

105 

10 

2o:d 

1U6 

10 

2o:d 

107 

10 

20  :d 

108 

10 

2o:o 

108 

10 

2o:d 

getbounds(fsp:  stp;  var  fmin.fmax:   integer); 
skip{fsys:  setofsys); 


1       foRiiiaRd; 

1  PROCEDURE  PRINTLINE; 
1    FORWARD; 

1  PROCEDURE  ENTERID(FCP:  CTP); 

2  FORWARD; 

1  PROCEDURE  INSYMBOL; 

1    FORWARD; 

1 

1  (*  FORWARD  DECLARED  PROCEDURES  USED  IN  BOTH  DECLARATIONPART  AND  BODYPART  *) 

1 

1  PROCEDURE  SEARCHSECTI0N(FCP:CTP;  VAR  FCPi:  CTP); 

3  FORWARD 

1  PROCEDURE  SEARCHID(FIDCLS:  SETOFIDS;  VAR  FCP:  CTP); 
3  FORWARD 
1  PROCEDURE 
1  FORWARD 
1  PROCEDURE 
5    FORWARD 

3  FUNCTION  pAOFCHAR(FSp:  STP):  BOOLEAN; 
1    FORWARD 

3  FUNCTION  STRGTYPE(FSp:  STP):  BOOLEAN; 
1    FORWARD 

3  FUNCTION  DECSIZEd:  INTEGER):  INTEGER; 
1    FORWARD 
1  PROCEDURE 
7    FORWARD 

3  FUNCTION  cOMPTYPES(FSPl»FSP2:  STP):  BOOLEAN; 
5    FORWARD 

1  PROCEDURE 

2  FORWARD 

1  PROCEDURE 

2  FORWARD 
1  PROCEDURE 
1    FORWARD 

1  PROCEDURE 

2  FORWARD 
1  PROCEDURE 
5  FORWARD 
5 

5  (*$I  tt5:C0MPGLBLS.TExT*) 
5  (♦SI  «5:C0MPINIT.TEXT*) 


CONSTANT(FSYS:  SETOFSYS;  VAR  FSP:  STP!  VAR  FVALU:  VALU); 


genbyte(Fbyte:  integer); 
genworo(FwoRD:  integer); 
writetext; 

writecode(forcebuf:  boolean); 
blockifsys:  setofsys); 
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5 
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11 

i:d 

1 

411 

11 

i:d 

1 

412 

11 

2:d 

1 

413 

11 

2:0 

0 

414 

11 

2:1 

0 

415 

11 

2:1 

5 

416 

11 

2:2 

8 

417 

11 

2:1 

21 

418 

11 

2:1 

26 

419 

11 

2:2 

30 

420 

11 

2:1 

43 

421 

11 

2:1 

48 

422 

11 

2:2 

52 

423 

11 

2:1 

75 

424 

11 

2:1 

80 

425 

11 

2:2 

84 

426 

11 

2:1 

97 

427 

11 

2:1 

02 

428 

11 

2:2 

06 

429 

11 

2:1 

19 

430 

11 

2:1 

24 

431 

11 

2:2 

28 

432 

11 

2:1 

41 

433 

11 

2:1 

46 

434 

11 

2:2 

50 

435 

11 

2:1 

68 

436 

11 

2:1 

73 

437 

11 

2:2 

77 

438 

11 

2:1 

95 

439 

11 

2:1 

00 

440 

11 

2:2 

04 

441 

11 

2:3 

16 

442 

11 

2:3 

31 

443 

11 

2:3 

41 

444 

11 

2:2 

52 

445 

11 

2:0 

52 

446 

11 

2:0 

64 

447 

11 

3:d 

1 

448 

11 

3:0 

1 

449 

11 

3:0 

0 

1  SEGMENT  PROCEDURE  C0f-"PINIT; 

PROCEDjRE    EFnITSTDTypES; 
BEGIN 

NEW (I NTPTR, SCALAR* STANDARD) ; 
WITH  IIMTPTR-^  DO 

BEGIN  SIZE  :=  INTSI2E;  FORM  :=  SCALAR;  SCALKIND  :=  STANDARD  END; 
NEW{REALPTR,SCALAR»STANDARD) ; 
WITH  REALPTR*"  DO 

BEGIN  SIZE  :=  REALSIZE;  FORM  :=  scalar;  SCALKIND  :=  STANDARD  END; 
NEW(LONGINTPTRiLONGlNT) ; 
WITH  LONGINTPTR'^  DO 

BEGIN  SIZE  :=  DECSIZE((BITSPERWD-1)*100  DIV  332  +  1);  FORM  :=  LONGINT  END; 
NEW(CHARPTR,SCALAR»STANDARD);  u   o*    t  ui 

WITH  CHARPTR''  do 

BEGIN  SIZE  :=  CHARSIZE;  form  :=  scalar;  SCALKIND  :=  STANDARD  END; 
NEW (300LPTR, SCALAR t DECLARED); 
WITH  800LPTR'"  DO 

BEGIN  SIZE  :=-B00LSIZE;  form  :=  scalar;  SCALKIND  :=  DECLARED  END; 
NEWCNILPTR, POINTER) ? 
WITH  NILPTR*  DO 

BEGIN  SIZE  :=  PTRSIZE;  FORM  :=  POINTER;  ELTYPE  :=  NIL  END; 
NEW(TEXTPTR.FILES)5 
WITH  TEXTPTR'^  DO 

M.w^'^^!!!.^^!^  r   filesize+charsize;  form  :=  files;  filtype  :=  charptr  end; 

NEWdNTRACTVPTR, FILES)  ; 
WITH  INTRACT\/PTR'^  DO 

BEGIN  SIZE  :=  FILESIZE+CHARSIZE;  FORM  :=  FILES;  FILTYPE  :=  CHARPTR  END; 
NEW (STRGPTR, ARRAYS* TRUE, TRUE); 
WITH  STRGPTR**  DO 

BEGIN  FORM  :=  ARRAYS;  SIZE  :=  (DEFSTRGLGTH  +  CHRSPERWD)  DIV  CHRSPERWD; 

AISPACKO  :=  TRUE;  AlSSTRNG  :=  TRUE;  INXTYPE  :=  INTPTR; 

ELWIDTH  :=  BITSPERCHR;  ELSPERWD  :=  CHRSPERWD; 

AELTYPE  :=  CHARPTR;  MaXLENG  :=  DEFSTRGLGTH; 
END 
END  (*ENTSTDTYPES«)  ; 

PROCEDURE  ENTSTDNAMES; 

VAR  CP.CPi:  CTP;  i:  INTEGER; 
BEGIN 
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0 

<+51 

3:i 

5 

402 

3:2 

8 

'+53 

3;i 

32 

*f5'+ 

3:i 

36 

i+SS 

3;i 

41 

<+56 

3:2 

44 

f57 

3:i 

69 

458 

3:i 

73 

459 

3:i 

78 

460 

3:2 

81 

461 

3:1 

06 

462 

3:1 

10 

463 

3:1 

15 

464 

3:2 

18 

465 

3:1 

43 

466 

3:1 

47 

467 

3:1 

52 

468 

3:2 

55 

469 

3:1 

80 

470 

3:1 

84 

471 

3:1 

89 

472 

3:2 

92 

473 

3:1 

17 

474 

3:i 

21 

475 

3:1 

26 

476 

3:2 

29 

477 

3:1 

54 

478 

3:1 

58 

479 

3:i 

63 

480 

3:2 

67 

481 

3:3 

92 

482 

3:2 

00 

483 

3:1 

02 

484 

3:1 

07 

485 

3:1 

12 

486 

3:2 

16 

487 

3:3 

41 

488 

3:2 

49 

489 

3:1 

51 

490 

3:1 

56 

=  »REAL 


=  »CHAR 


NEW (CPi TYPES) 
WITH  CP"  DO 

BEGIN  NAME 
ENTERIO(CP) ; 
•^EWCCP'TYPES) 
WITH  CP"  DO 

BEGIN  NAME 
ENTERID(CP) ; 
NEW(CP«TYPES) 
WITH  CP''  DO 

BESIN  NAME 
ENTERID(CP) ; 
NEW(CP»TYPES) 
WITH  CP''  DO 

BEGIN  NAME 
ENTERID(CP); 
NEW(CPiTYPES) 
WITH  CP^  DO 

BEGIN  NAME 
ENTERIDCCP); 
NEW<CP«TYPES) 
WITH  CP"  DO 

BEGIN  NAME 
ENTERIDCCP) ; 
NEW(CPtTYPES) 
WITH  CP*  DO 

BEGIN  NAME 
ENTERID(CP)5 

NEW( INPUTPTRfFORMALVARS.FA 
WITH  INPUTPTR*  00 

BEGIN  NAME  :=  »INPUT    • 

vlev  :=  o;  vaddr  :=  2 

END; 

enterid(inputptr) j 
new{outputptr«formalvars.f 
with  outputptr'*  do 
begin  name  :=  'output  » 
vlev  :=  0;  vaddr  :=  3 

END; 
ENTERID(OUTPUTPTR) ? 
NEW(CP»FORMALVARStFALSE)  ; 


=  'INTEGER  •!  IDTYPE  :=  INTPTR;  KLASS  :=  TYPES  END; 


♦;  IDTYPE  :=  realptr;  KLASS  :=  TYPES  end; 


IDTYPE  :=  charptr;  KLASS  :=  TYPES  end; 


=  •BOOLEAN  »;  IDTYPE  :=  BOOLPTR;  KLASS  :=  TYPES  END; 


=  tSTRING   »;  IDTYPE  :=  STRGPTR?  KLASS  :=  TYPES  ENDS 


=  'TEXT 


»;  IDTYPE  :=  textptr;  klass  :=  types  end; 


=  tlNTERACTt;  IDTYPE 
LSE)  ; 
;  IDTYPE 

ALSE); 
;  IDTYPE 


:=  INTRACTVPTR;  KLASS  :=  TYPES  END; 


:=  textptr;  klass  :=  forwalvarS; 


1=  textptr;  KLASS  :=  FORMALVARS; 
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11 
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99 

496 

11 

3:1 

03 

497 

11 

3:1 

06 

498 

11 

3:2 

17 

499 

11 

3:3 

22 

500 

11 

3:4 

25 

501 

11 

3:5 

31 

502 

11 

3:5 

37 

503 

11 

3:5 

66 

504 

11 

3:4 

79 

505 

11 

3:3 

81 

506 

11 

3:2 

85 

507 

11 

3:1 

95 

508 

11 

3:1 

01 

509 

11 

3:1 

06 

510 

11 

3:2 

09 

511 

11 

3:3 

29 

512 

11 

3;2 

42 

513 

11 

3:1 

44 

514 

11 

3:1 

48 

515 

11 

3:1 

53 

516 

11 

3:2 

56 

517 

11 

3:3 

56 
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11 

3:3 

75 
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11 

3:2 

83 

520 

11 

3:1 

87 
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11 

3:0 

91 
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11 

3:0 

06 
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11 

4:d 

1 

524 

11 

4:0 

0 

525 

11 

^:i 

0 

526 

11 

^11 

5 
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11 

'+:2 

9 
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11 

<*:! 

33 
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11 

4:1 

38 
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11 

4:2 

42 

531 

11 

'^.'S 

66 

WITH  CP'"  DO 

BEGIN  MAME  :=  'KtYBOARD';  IDTYPE  :=  TEXTPTR.;  KLASS  :=  FORNiALVARS; 
VLEV  :=  0;  VADDR  :=  4 

ENo; 
E|\)TERID(CP)  ; 

cpi  :=  NIL; 

FOR  I  :=  0  TO  1  DO 
BEGIN  NEW(CP«KONST) ; 
vilTH    CP'*  DO 

BEGIN  IDTYPE  :=  BOOLPTR; 

IF  I  =  0  THEN  NAME  :=  'FALSE    • 
ELSE  NAME  :=  'TRUE     ♦; 

NEXT  :=  CPl;  VALUES. IVAL  :=  I;  KLASS  :=  KONST 
END; 

enterid(cp);  CPI  :=  cp 
END; 
BOOLPTR". FCONST  •=  CP; 
NEW{CP»KONST) 5 
WITH  CP**  DO 

BEGIN  NAME  :=  'NIL      ♦;  IDTYPE  :=  NILPTR; 

NEXT  :=  NIL;  VALUES. IVAL  :=  0»  KLASS  :=  KONST 
END; 
ENTERID(CP); 
NEW(CP»KONST) ; 
WITH  cP"  DO 
BEGIN 

NAME  :=  'HAXINT   »;  IDTYPE  :=  INTPTR; 

KLASS  :=  konst;  values. ival  :=  maxint 

end; 

enterid(cp) ; 

END  {*ENTSTDNAMES*)  ; 

procedure  entundecl; 
begin 

new(utypptr»types)5 
with  utypptr**  Do 

BEGIN  name  :=  » 
NEW(UCSTPTR, KONST) ! 
WITH  UCSTPTR*^  DO 

BEGIN  NAME  :=  • 


•;  IDTYPE  :=  NIL;  klass  :=  types  END; 


VALUES. IVAL  :=  0;  KLASS  :=  KONST 


•;  IDTYPE  :=  nil;  next  i=  nil; 
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4:2 

4:i 
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4:1 
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4:3 

4:3 

4:3 
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4:1 
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74 

76 
81 
85 
04 
22 
24 
29 
33 
57 
65 
67 
72 
76 
00 
20 
35 
48 
50 
55 
59 
83 
03 
18 
31 
33 
46 
1 
1 
1 
4 
0 
0 
60 
20 
80 
40 
00 
60 
20 
80 


end; 
NEW(UVARPTR,ACTUALVARStFALSE) ; 

WITH  UVARPTR''  DO 

RFrTM  ,MflME  :=  •       •'  lUTYPE  :=  nil; 

;^rXT  1=  nil;  VLEV  :=  0;  VADDR  :=  0;  KLASS  :=  ACTUALVARS 

end; 

NEW(UFLDPTRiFIELD) ' 

FLOADDR  :=  0;  KLASS  :=  FIELD 

END  * 
NEW (JPRCPTR.PROC, DECLARED, ACTUAL  I  FALSE); 

"'begin'naIe^'^       m  idtype  :=  nil;  forwdecl  :-  false; 

NEXT  :=  nL;  inscope  :=  false;  locallc  :=  o;  exturnal  :=  false; 
pflev  :=  0;  pFNAME  :=  0;  pfseg  :=  o;  .^,.,«, 

KLASS  :=  PROc;  pfdeckind  :=  declared;  pfkind  :=  actual 

NEW (UFCTPTRiFUNC, DECLARED, actual, FALSE); 
'''Ifrfu^lllT-^  •;  IDTYPE  :=  nil;  NEXT  :=  NIL; 

'''forwdecl  ;=  false;  exturnal':=  false;  inscope  :=  false;  locallc  :=  o; 
PPLEV  :=  0;  PFNAME  :=  0;  pfseg  :=  0; 
KLASS  :=  FUNc;  pfdeckind  :=  declared;  pfkind  :=  actual 

END 
END  (♦ENTUNDECL*)  ; 


PROCEDURE  ENTSPCPROCS 
LABEL  1; 

\/AR  lcp: 


BEGIN 
NAC 
NAC 
NAC 


na: 

13 

4: 
73 
NACIOD 
NAC13D 
NAC16] 
NAC19D 
NAC223 
NAC25] 


CTP;  i:  integer;  isfunc:  boolean; 

ARRAY  CI. .433  OF  ALPHA; 


•READ  ' 

•WRITELN  • 

»PRED  ' 

•SQR  * 

♦unitread* 

•LENGTH   • 
•COPY     • 

•moverigh^ 
•treesear^ 


NAC  23  :=  'READLN 


NAC  53 
NAC  83 
NAC113 
NAC143 
NAC173 
NAC203 
NAC233 


•EOF 

•SUCC 

•ABS 

♦UNITWRIT 

•INSERT 

•POS 

•EXIT 


NAC263  :=  •TIME 


NAC  33 
NAC  63 
NAC  93 
NAC123 
NAC153 
NAC183 
NAC213 
NAC243 
NAC273 


•WRITE 

•EOLN 

»ORD 

»NEW 

•CONCAT 

'DELETE 

•MOVELEFT 

♦IDSEARCH 

•FILLCHAR 
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11 

5:i 

40 

NAC2a3  :=  'OPENNEW  •;  NAC29D 

:=  'OPENOLD  •;  NAE303  :=  'REWRITE  'l 

571 

11 

5:i 

00 

NAC31D  :=  'CLOSE    •;  NAi:32D  :=  'SEEK     •;  NAC33D  :=  VRESET    'i 

575 

11 

5:i 

60 

NAC34:  :=  'GET      •;  NAC353  :=  »PUT      •;  NAC363  :=  'SCAN     «! 

576 

11 

5:i 

20 

NAC37:  :=  'BLOCKREA*;  NAC383  :=  •3L0CKWRI»S  NAC39D  :=  'TRUNC    '; 

577 

11 

5:i 

80 

NAi:40]  :=  'PAGE     •;  NAC41:  :=  »SIZE0F   •  ;  NAt:423  :=  'STR      »; 

578 

11 

5:i 

40 

NAC43D  :=  'GOTOXY   '? 

579 

11 

5:i 

60 

FOR  I  :=  1  TO  43  00 

580 

11 

5:2 

74 

BEGIN 

581 

11 

5:3 

74 

IF  TINY  THEN 

582 

11 

5:4 

78 

IF  I  IN  C2»7»8«10»13,l7,18»19.20.32i34, 

35,40,42,433  THEN 

583 

11 

5:5 

92 

GOTO  1; 

58H 

11 

5:3 

94 

ISFUNC  :=  I  IN  C5,6,7,8,9,10»11.15il6,l9,20 

,25,36,37,38,39,43 

585 

11 

5:3 

08 

IF  ISFUNC  THEN  NEW (LCP«FUNC , SPECIAL ) 

586 

11 

5:3 

16 

ELSE  NEW(LCP,PROCiSPEClAL) ; 

587 

11 

5:3 

23 

WITH  LCP*^  DO 

588 

11 

5:4 

27 

BEGIN  NAME  :=  NACI3;  NEXT  :=  NIL?  IDTYRE 

:=  nil; 

589 

11 

5:5 

53 

IF  ISFUNC  THEN  KLASS  :=  FUNC  ELSE  KLASS 

:=  PROC; 
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11 

5:5 

72 

PFDECKIND  ;=  SPECIAL;  KEY  :=  I 

591 

11 

5:4 

84 

end; 

592 

11 

5:3 

66 

ENTERID(LCP); 

593 

11 

5:3 

90 

1:     END 

594 

11 

5:0 

90 

END  (♦ENTSPCPROCS*)  ; 

595 

11 

5:0 

1  12 

596 

11 

6:0 

1 

PROCEDURE  ENTSTDPRQCS; 

597 

11 

6:d 

1 

VAR  LCPtPARAM:  CTP?  LSP.FTYPE:  STP;  i:  INTEGER; 

isPROc:  boolean; 

598 

11 

6:d 

7 

NA:  ARRAY  Cl,,193  OF  ALPHA; 

599 

11 

6:0 

0 

BEGIN 

600 

11 

6:1 

0 

NAC  13  :=  'ODD      •;  NAC  23  " 

;=  'CHR      •;  NAC 

33  :=  'memavail'; 

601 

11 

6:1 

60 

NAC  43  :=  'ROUND    *;  NAC  53  . 

;=  'SIN     •;  NAC 

63  :=  'COS     •; 

602 

11 

6;i 

20 

NAC  73  :=  'LOG      •;  NAC  83  ! 

:=  'ATAN     •;  NAC 

93  :=  'LN      '; 

603 

11 

6:1 

80 

NAC103  :=  'EXP      »;  NAC113  ! 

;=  'SORT     •;  NAC123  :=  'MARK     '; 

60f 

11 

6:1 

40 

NACI33  :=  'RELEASE  ';  NAC143 

:=  'lORESULT';  NAC153  :=  'UNITBUSY'; 

605 

11 

6:1 

00 

NAC163  :=  'PWROFTEN';  NAC173  . 

:=  'UNITWAIT';  NAC183  :=  'UNITCLEA'; 

606 

11 

6:1 

60 

NAC193  :=  'HALT     '; 

607 

11 

6:1 

80 

FOR  I  :=  1  TO  19  DO 

608 

11 

6:2 

92 

BEGIN  ISPROC  :=  I  IN  C 12 . 13, 17. 18, 193? 

609 

11 

6:3 

04 

CASE  I  OF 

610 

11 

6:3 

07 

1:   BEGIN  FTYPE  :=  BOOLPTR;  NEW(PARAM,ACTUALVARS, FALSE ) ; 

611 

11 

6:5 

16 

WITH  PARAW*  DO 

612 

11 

6:6 

19 

BEGIN  IDTYPE  1=  INTPTR;  KLASS  :=  ) 

^CTUALVARS  END 
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11 

6:1+ 

31 

end; 
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6:5 
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11 
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6:4 
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11 

6:3 

28 
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11 
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36 
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11 

6:5 

45 
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11 

6:6 

48 

629 

11 

6:4 

60 

630 

11 

6:3 

62 

631 

11 

6:3 

68 

632 

11 

6:3 

73 

633 

11 

6:3 

79 
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11 

6:3 

26 

635 

11 

6:3 

34 

636 

11 

6:3 

41 

637 

11 

6:4 

44 

638 

11 

6:5 

69 

639 

H 

6:5 

86 

640 

11 

6:5 

96 

641 

11 

6:4 

06 

642 

11 

6:3 

08 

643 

11 

6:2 

09 

644 

11 

6:0 

12 

645 

11 

6:0 

40 

646 

11 

7:d 

1 

647 

11 

7:d 

1 
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11 

7:0 

0 

649 

11 

7:1 

0 
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11 

7:2 
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11 

7:i 

16 

652 

11 

7:1 
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11 

7:1 

34 
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11 
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342 

2:   FTYPE  :=  charptr; 

3:   BEGIN  FTYPE  :=  INTPTR;  PARAM  :=  NIL  END; 

4:   BEGIN  FTYPE  :r  INTPTR;  NEW ( PARAM . ACTUALVARS .FALSE ) ; 

WITH  PARAM*^  DO  3E&IN  IDTYPE  :=  REALPTR;  KLASS  :=  ACTUALVARS  END 

end; 
5:  FTYPE  :=  realptr; 

12:   BEGIN  FTYPE  :=  NIL;  NEW (PARAM, FORMALVARS. FALSE ) ;  NEW (LSP, POINTER ) : 
WITH  LSP**  DO 

BEGIN  SIZE  :=  PTRSIZE;  FORM  :=  POINTER;  ELTYPE  :=  NIL  END; 
WITH  PARAM"  DO  BEGIN  IDTYPE  :=  LSP;  KLASS  :=  FORMALVARS  END 

end; 

14:   BEGIN  FTYPE  :=  INTPTR;  PARAM  :=  NIL  END; 
15:   BEGIN  FTYPE  :=  BOOLPTR;  NEW (PARAM, ACTUALVARS, FALSE) ; 
WITH  PARAM'^  DO 

BEGIN  IDTYPE  :=  INTPTR;  KLASS  :=  ACTUALVARS  END; 

end; 
16:  FTYPE  :=  realptr; 
17:  ftype  :=  nilj 

19:  begin  ftype  :=  nil;  param  :=  nil  end 
end  (*param  and  type  cases*)  j 
if  isproc  then  new(lcp,proc, standard) 
else  new(lcp,func, standard); 
with  lcp*"  do 
begin  name  :=  naci3;  pfdeckind  :=  standard;  cspnum  :s  i  ♦  20; 
if  isproc  then  klass  :=  proc  else  klass  :=  fung; 
if  param  <>  nil  then  param". next  ;s  nil; 
idtype  :=  ftype;  next  :=  param 
end; 
enterid(lcp) 

END 
END  (*ENTSTDPROCS*)  ; 

PROCEDURE  INITSCALARS; 

VAR  I:  NONRESIDENT; 
BEGIN 

IF  MEMAVAIL  >  9950  (*  EMPIRICAL  VALUE  FQR  A  50K  BYTE  MACHINE  ♦)  THEN 

noswap  :=  true  else  noswap  :=  false; 
fwptr  :=  nil;  modptr  :=  nil;  globtestp  :=  nil; 

LINESTART  :=  0;  LINEINFO  :=  LCAFTERMARKSTACK ;  LIST  :=  FALSE; 
SYMBLK  :=  2;  SCREENDOTS  :=  0;  STARTOOTS  :=  0; 

FOR  seg  :=  0  TO  maxseg  do 
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11 

7:2 

54 
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7:3 
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11 
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57 
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11 

7:1 
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664 

11 

7:1 

79 
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11 

7:1 

00 
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11 

7:1 

06 

667 

11 

7:1 

23 

668 

11 

7:1 

34 

669 

11 

7:1 

43 

670 

11 

7:1 

55 

671 

11 

7:1 

67 

672 

11 

7:1 

93 

673 

11 

7:1 

00 

674 

11 

7:1 

06 

675 

11 

7:0 

06 

676 

11 

7:0 

26 

677 

11 

8:0 

1 

678 

11 

8:0 

0 

679 

11 

8:1 

0 

680 

11 

a:i 

15 

681 

11 

8:1 

29 

682 

11 

8:1 

31 

683 

11 

8:1 

51 

684 

11 

8:1 

67 

685 

11 

8:1 

69 

686 

11 
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85 

687 

11 

8:1 

99 

688 

11 

8:1 

01 
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11 

8:1 

17 

690 

11 

8:1 

31 

691 

11 

6:0 

31 
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11 

8:0 
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0 
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11 

1:1 

0 

695 

11 

1:1 

4 

WITH  SEGTABLECSEGJ  DO 

atGiN  DISKADDR  :=  0;  CODELENG  :=  05  SEGNAME  :=  •         ♦; 

SEGKIND  :=  0  5  TEXTADDR  :=  0 
END; 
USINGLIST  :=  NIL; 

IF  USERINFO. STUPID  THEN  SYSTEMLIB  1=  •♦SYSTEM. PASCAL* 
ELSE  SYSTEMLIB  :=  ' ♦SYSTEM. LIBRARY' ; 

Lc  :=  lcaftermarkstack;  iocheck  :=  true;  dp  :=  true; 
SEGiNx  :=  0;  nextjtab  :=  i;  nextproc  :=  2;  curproc  :=  u 

NEW(scONST);  NEW(SYMBUFP) ;  NEW(CODEP); 

clinkeRInfo  :=  false;  dlinkerinfo  :=  false; 

SEG  :=  i;  nextseg  :=  10;  curblk  :=  i;  curbyte  :=  o«  lsepproc  ;=  false; 

startingup  :=  true;  noisy  :=  not  userinfo.slowterm?  sepproc  :=  false; 

DEBUGGING  :=  FALSE;  BPTONLINE  :=  FALSE;  INMOQULE  !=  FALSE; 

gotook  :=  FALSE;  rangecheck  :=  TRUE;  sYscoMP  :=  false;  tiny  :=  false; 
coDEiNSEG  :=  false;  prterr  :=  true;  including  :=  false;  using  :=  false; 

for  I  :=  SEEK  to  DECOPS  do  PFNUM0FCI3  :=  o; 
COMMENT  :=  nil;  LIBNOTOPEN  :=  TRUE; 
GETSTMTLEV  :=  TRUE;  BEGSTMTLEV  :=  0; 
FLIP3YTES  :=  FALSE 
END  (♦INITSCALARS^)  ; 

PROCEDURE  INITSETS; 
BEGIN 

constbegsys  :=  CADD0P,INTC0NST,REALC0NST,STRINGC0NST,IDENT3J 

simptypebegsys  ;=  clparenti  +  constbegsys; 

typebegsys  :=  CARROW,PACKEDSYiARRAYSY»RECORDSY»SETSY«FILESYD 

+  SIMPTYPEBEGSYS; 
TYPEdELS  :=  CARRAYSY,REC0RDSY,SETSYfFILESY3; 
BLOCKBEGSYS  :=  CUSESSY.LABELSY»CONSTSY»TYPESYiVARSY, 

PR0CSYiFUNCSY,PR0GSY,BEGINSY3; 
SELECTSYS  :=  C ARROW, PERIOD. LBRACKD; 
FACBEGSYS  :=  C INTC0NST»REALC0NST,L0NGC0NST. STRINGCONST, IDENT. 

LPARtNT»LBRACK,N0TSY3; 
STAT3E6SYS  :=  CBEGlNSYt GOTOSY, IFSY, WHILESYf REPEATSY,FORSY, WITHSY.CASESYD; 
VARS  :=  CFORMALVARS,ACTUALVARS] 
END  (♦INITSETS^)  ; 

BEGIN  (♦COMPINIT+) 

INITSCALARS;  INITSETS; 

LEVEL  :=  o;  TOP  :=  o; 
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11 

1:1 
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1:1 
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11 

1:2 

45 
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11 

1:3 
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11 

1:2 

64 
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1:1 
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1:2 

82 
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11 
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21 
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11 
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26 
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11 
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11 

1:5 

84 
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1:2 

04 
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35 
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IF  NOISY  THEN 
BEGI'-J 

FOR  IC  :=  1  TO  7  DO  WR ITELN ( OUTPUT ) ; 
^RITELN(0UTPUT, 'PASCAL  COMPILER  CII.0.A.13M; 
WRlT£(OUTPUT.  •<    0>M 

end; 

WITH  DisPLAYCO:  DO 

BEGIN  FNAME  :=  NIL;  FFILE  :=  NIL;  FLABEL  :=  NIL;  OCCUR  :=  BLCK  END; 

smallestspace;=memavail; 
getnextpage; 

INSYM30L; 

ENTSTDTyPES;    ENTsTDNAMES;    ENTUNDECL; 

ENTSPCPROCS;    ENTSTDPROCS; 

IF  SYSCOMP  THEN 

BEGIN  OUTERBLOCK  :=  NIL;  SEG  :=  O;  NEXTSEG  J=  1; 

GLEV  :=l;  BLOCKBEGSYS  5=  3L0CKBEGSYS  +  CUNITSY.SEPARATSY3 
END 
ELSE 

BEGIN  TOP  :=  1;  LEVEL  :=  15 
WITH  DISPLAYCID  DO 

BEGIN  FNAME  :=  NIL;  FFILE  :=  NIL5 

FLABEL  :=  NIL;  OCCUR  :=  BLCK 
END; 
LC  :=  LC+2;  GLEV  :=  3;  (♦KEEP  STACK  STRAIGHT  FOR  NOW*) 
NEW { OUTERBLOCK, PROC, DECLARED* ACTUAL. FALSE)} 
WITH  OUTERBLOCK*  00 

BEGIN  NEXT  :r  NIL;  LOCALLC  :=  LC; 

NAME  :=  'PROGRAM  »;  IDTYPE  :=  NIL;  KLASS  :=  PROC ; 

PFDECKIND  •=  DECLARED;  PFLEV  1=  O;  PFNAME  :=  l;  PFSEG  :=  SEG; 

PFKIND  :=  actual;  forwdecl  :=  false;  exturnal  :=  false; 

INSCOPE  :=  TRUE 

END 

end; 
if  sy  =  progsy  then 

BEGIN  INSYMBOL; 

IF  SY  =  IDENT  THEN 

BEGIN  SEGTABLECSE63.SEGNAME  ;=  ID; 
IF  OUTERBLOCK  <>  NIL  THEN 
BEGIN 

OUTERBLOCK'*. NAME  :=  ID; 

ENTERID(OUTERBLOCK)  (*ALLOWS  EXIT  ON  PROGRAM  NAME*) 


737  11  lie  ^+3  END 

738  11  1:4  46  £ND 

739  11  1:3  46        ELSE  ERR0R(2);  INSYMBOL; 
7'+0  11  1:3  55         IF  SY  =  LPARENT  THEN 
7^+1  11  1:4  60  3EGIN 

7if2  11  1:5  60  REPEAT  INSyMBOL 

743  11  1:5  60  UNTIL  SY  IN  CRPARENTt SEMIC0L0N3+BL0CKBEGSYS ; 

7^+4  11  1:5  75  IF  SY  =  RPARENT  THEN  INSYMBOL  ELSE  ERROR(f) 

745  11  1:4  86  END; 

746  11  113  89        IF  SY  =  SEMICOLON  THEN  INSYMBOL  ELSE  ERR0R(14) 

747  11  1!2  00      END? 

748  11  1:1  03    MARK(MARKP); 

749  11  1:1  07    NEW(TOS); 

750  11  1:1  12    WITH  TOS^  DO   (*MaKE  LEXSTKREC  FOR  OUTERBLOCK*) 

751  11  1:2  16      BEGIN 

752  11  1:3  16      prevlexstackp:=nili 

753  11  1:3  21      bfsy:=period; 

754  11  1:3  26     ofprocp:=outerblock; 

755  11  1:3  32        DLLC:=LCJ 

736  11  1:3  37        D0LDLEV:=LEVEL; 

757  11  1:3  43        D0lDT0P:=T0P5 

758  11  1:3  46        POLDPROC:=CURPROCi 

759  H  1:3  52        ISSEGMENT:=FALSEJ 

760  11  1:3  57        DMARKPlsMARKP; 

761  11  1:2  63      end; 

762  11  1:0  63  END  (♦COmpINIT*)  ; 

763  11  1:0  80  (*$l  «5:C0MPINIT.TEXT*) 

763  11  i:o  80  (*$i  «5:decpart.a.text*) 

764  11  1:0  80 

765  11  1:0  80  (*     COPYRIGHT  (C)  1979,  REGENTS  OF  THE         *) 

766  11  1:0  80  (♦     UNIVERSITY  OF  CALIFORNIA,  SAN  DIEGO        *) 

767  11  i:o  80 

768  12  1:d      1  SEGMENT  PROCEDURE  DECLARATIONPARKFSYS:  SETOFSYS); 

769  12  1:d      5  VAR  LSY:  SYMBOL; 

770  12  1:d  6      NOTDonE:  BOOLEAN; 

771  12  1:D  7      DUMMyvAR:  ARRAYC0..03  OF  INTEGER;  (*FOR  PRETTY  DISPLAY  OF  STACK  AND  HEAP  ♦) 

772  12  1:d  8 

773  12  2:d  1    PROCEDURE  TYP(FSYS:  SETOFSYS;  VAR  FSPI  STP;  VAR  FSIZE:  ADDRRANGE); 

774  12  2:0  7    var  lsp.lspl ,lsp2:  stp;  oldtop:  disprange;  lcp:  ctp; 

775  12  2:d  12       lsize,displ:  addrrange;  lmin,lmax:  integer; 

776  12  2:d  16  packing:  BOOLEAN;  NEXT3IT,NUMBITS:  BITRANGE; 
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VAR  fsp:stp;  var 
ttop:  disprangE; 


THEN 
SIMPTYPEBEGSYS) 


ENDJ 


:=  intsize; 
:=  declared 

LCNT  :=  0! 


FORM  :=  SCALAR; 


PROCEDURE  SlMPLETYPE(FSYS:SETOFSYS; 

var  LSP.LSPi:  sTP;  LCPtLCPi:  ctp; 
lcnt:  integer;  lvalu:  valu; 

BEGIr^  FSIZE  :=  1; 

IF  NOT  (SY  IN  SIMPTYPEBEGSYS) 
3EGIN  ERR0R(1)5  SKIP(FSYS  + 
IF  SY  IN  SIMPTYPEBEGSYS  THEN 
3EGIN 

IF  SY  =  LPARENT  THEN 
BEGIN  TTOP  :=  TOP; 

WHILE  DISPLAYCT0P3. OCCUR  <>  BLCK  DO  TOP  :=  TOP  -  I 
NEW (LSP I  SCALAR. DECLARED); 
WITH  LSP"  DO 
BEGIN  SIZE 
SCALKIND 
END; 

LCPi  :=  NIL; 

REPEAT  INSYMBOL; 

IF  SY  =  XDENT  THEN 

BEGIN  NEW(LCP.KONST); 
WITH  LCP'*  DO 

BEGIN  NAME  :=  ID;  IDTYPE  :=  LSP;  NEXT 
VALUES. IVAL  :=  LCNT;  KLASS  :=  KONST 
END; 
ENTERID(LCP); 
LCNT  :=  LCNT  +  i; 
LCPI  :=  LCP;  INSYMBOL 
END 
ELSE  ERR0R(2) ; 

IF  NOT  (SY  IN  FSYS  +  CCOMMA.RPARENT])  THEN 
BEGIN  ERR0R(6);  SKIP(FSYS  +  CC0MMA,RPARENTD) 
UNTIL  SY  <>  COMMA; 
LSP^.FCONST  :=  LCPl; 
IF  SY  =  RPARENT  THEN 
END 
ELSE 
BEGIN 

IF  SY  =  IDENT  THEN 

BEGIN  SEARCHID(CTYPES.KONSTD.LCP) ; 
INSYMBOL; 


fsize:addrrange) 


:=  LCPi; 


END 


TOP  :=  TTop; 

INSYMBOL  ELSE 


error  Ct) 
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IF  LCP'^.KLASS  =  KONST  THEN 
BEGIN  NEW (LSP, SUBRANGE) ; 
WITH  LSP**,  LCP'"  DO 

BEGIN  RANGETYPE  :=  IDTYPE;  FORM  :r  SUBRANGE; 
IF  STRGTYPE(RANGETYPE)  THEN 

BEGIN  ERR0R(148);  RANGETYPE  :=  NIL  END; 
MIN  :=  VALUES;  SIZE  :=  INTSIZE 
END; 
IF  SY  =  COLON  THEN  INSYMBOL  ELSE  ERR0R(5); 
C0NSTANT(FSYS,LSP1,LVALU) ; 
LSP'^.MAX  :=  LVALU; 
IF  LSP*^. RANGETYPE  <>  LSPl  THEN  ERROR{107) 

ELSE 

BEGIN  LSP  :=  LCP'^, IDTYPE; 

IF  (LSP  =  STRGPTR)  AND  ( SY  =  LBRACK)  THEN 
BEGIN  INSYMBOL; 

CONSTANT(FSYS  +  CRBRACKDtLSPl , LVALU) ; 
IF  LSPl  =  INTPTR  THEN 
BEGIN 

IF  (LVALU. IVAL  <=  0)  OR 

(LVALU. IVAL  >  STR6LGTH)  THEN 
BEGIN  ERROR(203); 

LVALU, IVAL  :=  DEFSTRGLGTH 
END; 
IF  LVALU. IVAL  <>  DEFSTRGLGTH  THEN 
BEGIN  NEW(LSP,ARRAYStTRUEtTRUE); 
LSP**  :=  STRGPTR^; 
WITH  LSP'^tLVALU  DO 

BEGIN  MAXLENG  :=  IVAL; 

SIZE  :=  (IVAL+CHRSPERWD)  DIV  CHRSPERWD 
END 

END 

END 

ELSE  ERRORdS); 

IF  SY  =  RBRACK  THEN  INSYMBOL  ELSE  ERR0R(X2) 

END 

ELSE 

IF  LSP  =  INTPTR  THEN 
IF  SY  =  LBRACK  THEN 
BEGIN  INSYMBOL; 
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859 

12 

3:3 

69 

860 

12 

3:3 

74 

861 

12 

3:3 

79 

362 

12 

3:3 

01 

863 

12 

3:4 

06 

86*+ 

12 

3:4 

09 

865 

12 

3:4 

18 

866 

12 

3:5 

23 

867 

12 

3:3 

25 

868 

12 

3:3 

37 

869 

12 

3:2 

51 

870 

12 

3:i 

51 

871 

12 

3:2 

53 

872 

12 

3:3 

59 

873 

12 

3:4 

63 

874 

12 

3:5 

68 

875 

12 

3;9 

74 

876 

12 

3:8 

81 

877 

12 

3:6 

83 

878 

12 

3:5 

83 

879 

12 

326 

85 

880 

12 

3:7 

95 

881 

12 

3:7 

12 

882 

12 

3:8 

20 

883 

12 

3:7 

29 

884 

12 

3:8 

32 

885 

12 

3:7 

47 

886 

12 

3:7 

61 

887 

12 

3:7 

75 

888 

12 

3:7 

82 

889 

12 

3:6 

89 

890 

12 

3:5 

92 

891 

12 

3:6 

97 

892 

12 

3:7 

00 

893 

12 

3:8 

06 

894 

12 

319 

12 

895 

12 

3:9 

22 

896 

12 

3:0 

27 

897 

12 

3:1 

34 

898 

12 

3:4 

44 

899 

12 

3:3 

44 

NEw(LSP»LOf\lGlNT)  ; 

LSP^    :=  LONGINTPTR*; 

CONSTANKFSYS  +  CRBRACKD*  LSPl  t  LVALU  )  ; 

IF  LSPl  =  INTPTR  THEM 

IF  (LVALU.IVAL  <=  0)  OR 

(LVALU.IVAL  >  MAXDEC)  THEN  ERROR(203) 
ELSE 

LSP'^.SIZE  :=  DECSIZE(LVALU.IVAL) 
ELSE  ERR0R(15) ; 

IF  SY  =  RBRACK  THEN  INSYMBOL  ELSE  ERROR{12)5 
END 
ELSE 

IF  LSP'^.FORM  =  FILES  THEN 
IF  INMODULE  THEN 

IF  NOT  ININTERFACE  THEN 

ERRQR(191);  (*N0  PRIVATE  FILES*) 
IF  LSP  <>  NIL  THEN  FSIZE  :=  LSP'^.SIZE 
END 
END  (*Sy  =  lOENT*) 
ELSE 

BEGIN  NEW(LSP, SUBRANGE);  LSP*. FORM  :=  SUBRANGE; 
CONSTANT(FSYS  +  CCOLOND* LSP1»LVALU) I 
IF  STRGTYPE(LSPl)  THEN 

BEGIN  ERR0R(148);  LSPl  :=  NIL  END; 
WITH  LSP**  DO 

BEGIN  RANGETYPE:=LSPi;  min:=lvalu;  size:=intsize  end; 

IF  SY  =  COLON  THEN  INSYMBOL  ELSE  ERR0R(5); 
CONSTANT(FSYS.LSPlfLVALU) ; 
LSP'". MAX  :=  LVALU; 

IF  LSP'^.RANGETYPE  <>  LSPl  THEN  ERROR(107) 
END; 
IF  LSP  0  NIL  THEN 
WITH  LSP**  DO 

IF  FORM  =  SUBRANGE  THEN 
IF  RANGETYPE  <>  NIL  THEN 

IF  RANGETYPE  =  REALPTR  THEN  ERR0R(399) 
CLSE 

IF  MiN.iy/AL  >  MAX.IVAL  THEN 

begin  err0r{102);  max.ival  :=  min.ival  end 
end; 

FSP  :=  LSP; 
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12 
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47 
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12 

3:4 

57 

902 

12 

3:2 

71 

903 

12 

3:i 

71 

901+ 

12 

3:o 

74 

905 

12 

3:o 

02 

906 

12 

4:d 

3 

907 

12 

4:d 

4 

908 

12 

4:o 

0 

909 

12 

4:i 

3 

910 

12 

4:2 

12 

911 

12 

4:3 

15 

912 

12 

4:3 

19 

913 

12 

4:3 

19 

914 

12 

4:5 

29 

915 

12 

4:6 

37 

916 

12 

4:7 

42 

917 

12 

4:8 

45 

918 

12 

4:8 

52 

919 

12 

4:9 

57 

920 

12 

4:0 

62 

921 

12 

4:0 

69 

922 

12 

4:9 

72 

923 

12 

4:7 

77 

924 

12 

4:5 

79 

925 

12 

4:3 

61 

926 

12 

4:5 

89 

927 

12 

4:6 

98 

928 

12 

4:6 

03 

929 

12 

4:7 

08 

930 

12 

418 

11 

931 

12 

4:7 

11 

932 

12 

4:5 

15 

933 

12 

4:3 

15 

934 

12 

4:0 

34 

935 

12 

4:0 

48 

936 

12 

5:d 

1 

937 

12 

5:d 

6 

938 

12 

5:d 

16 

939 

12 

5:d 

20 

940 

12 

5:d 

22 

END 


IF  NOT  (SY  IN  FSYS)  T4EN 

BEGIig    ERR0K(6);     SKIP(FSYS)     END 
END 

ELSE    FSP    :=    NIL 
(♦SIMPLETYPE*)     ! 


FUNCTION  PACKABLe(F 

VAR  lmin.lmax:  in 

BEGIN  PACKABLE  :=  F 
IF  (FSP  <>  NIL)  A 
WITH  FSP^  DO 
CASE  FORM  OF 
SUBRANGE, 

scalar:  IF 


sp:  stp):  boolean; 

teger; 

alse; 

nd  packing  then 


power: 


IF 


END 


END  (*  CASES 
(♦PACKABLE*)  ; 


(FSP  0  INTPTR)  AND  (FSP  <>  REALPTR) 
BEGIN  GETBOUNDS(FSP»LMIN,LMAX); 
IF  LMIN  >=  0  THEN 

BEGIN  PACKABLE  :=  TRUE? 
NUMBITS  :=  1;  LMIN  :=  1? 
WHILE  LMIN  <  LMAX  DO 

BEGIN  LMIN  :=  LMIN  +  1 ; 
LMIN  :=  LMIN  +  LMIN  -  U 
NUMBITS  :=  NUMBITS  +  1 
END 
END 

end; 
packable(elset)  then 

BEGIN  GETB0UNDS(ELSET,LMIN»LMAX) ; 
LMAX  :=  LMAX  +  i; 
IF  LMAX  <  BITSPERWD  THEN 
BEGIN  PACKABLE  :=  TRUE; 

NUMBITS  :=  LMAX 
END 
END 

*); 


THEN 


PROCEDURE  FIELDLIST(FSYS:  SETOFSYS;  VAR  FRECVAR;  STP) ; 

VAR  LCP,LCP1»NXT»NXT1»LAST:  CTP;  LSP»LSPlfLSP2,LSP3»LSP4:  STP; 
MlNSIZEfMAXSl2E,LSlZE:  ADDRRANGE;  LVALU:  VALU; 
MAXBIT.MINBIT:  BITRANGE; 
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3 

945 

12 

s:2 

b 

946 

12 

6:3 

14 

947 

12 

6:4 

14 

946 

12 

6:5 

25 

949 

12 

6:4 

40 

950 

12 

6:4 

52 

951 

12 

6:4 

66 

952 

12 

6:3 

69 

953 

12 

6:2 

76 

954 

12 

6:3 

78 

955 

12 

6:4 

90 

956 

12 

6:4 

97 

957 

12 

6:4 

09 

958 

12 

6:5 

15 

959 

12 

6:3 

20 

960 

12 

6:1 

25 

961 

12 

6:2 

34 

962 

12 

6:3 

39 

963 

12 

6:4 

44 

964 

12 

6:4 

54 

965 

12 

6:5 

58 

966 

12 

6:6 

71 

967 

12 

6:0 

81 

968 

12 

6:0 

94 

969 

12 

7:d 

1 

970 

12 

7:d 

1 

971 

12 

7:0 

0 

972 

12 

7:1 

6 

973 

12 

7:2 

11 

974 

12 

7:1 

26 

975 

12 

7:1 

33 

976 

12 

7:1 

36 

977 

12 

7:2 

41 

973 

12 

7:3 

41 
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12 

7:3 

52 

980 

12 

7:3 

60 
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12 

7:4 

65 

PROCEDURE  ALLOCAIECFCP:  CTP); 

VAK  ONBOUND:  BOOLEAN; 
BEGIN  ONBOUND  :=  FALSE; 
WITH  FCP"  DO 

IF  PACKABLEdDTYPE)  THEN 
3EGIN 

IF  (NUMBITS  +  NEXT3IT)  >  BITSPERWD  THEN 

BEGIN  DISPL  :=  DISPL  +  1;  NEXTBIT  :=  0! 
FLDADDR  :=  DISPL;  FISPACKD  ;=  TRUE; 
FLDWIOTH  :=  NUMBITS;  FLDRBIT  :=  NEXTBIT; 
NEXTBIT  :=  NEXTBIT  +  NUNIBITS 
END 
ELSE 

BEGIN  OISPU  :=  DISPL  +  ORD(NEXTBIT  >  0); 
NEXTBIT  :=  0;  ONBOUND  :=  TRUE; 
FISPACKD  :=  FALSE;  FLDADDR  :=  DISPL; 
IF  IDTyPE  0  NIL  THEN 

DISPL  :=  DISPL  +  IDTYPE'^.SIZE 

end; 

0  NIL)  THEN 
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ONBOUND  ;=  TRUE  END; 


IF  ONBOUND  AND  (LAST 
WITH  LAST^  DO 

IF  FISPACKD  THEN 
IF  FLDRBIT  =  0 
ELSE 

IF  (FLDWIDTH 


THEN  FISPACKD  :=  FALSE 


BEGIN 
END  (*ALLOCATE*)  I 


<=  8)  AND  (FLDRBIT  <=  8)  THEN 
FLDWIDTH  :=  8;  FLDRBIT  :=  8  END 


procedure  variantlist; 
vaR  gottagname:  boolean; 

BEGIN  NEW(LSP,TAGFL0) ; 
WITH  LSP**  DO 

BEGIN  TAGFIELDP  :=  NIL;  FSTVAR  ;=  NIL;  FORM  :=  TAGFLD  END; 

frecvar  :=  LSP5 
insymbol; 

if  sy  =  ident  then 
begin 

IF  packing  THEN  NEW ( LCP, FIELD. TRUE) 
ELSE  NEWCLCP, FIELD. FALSE) ; 
WITH  LCP*^  DO 

BEGIN  lOTYPE  :=  NIL;  KLASS ; =FIELD; 


982 

12 

7:b 

75 

383 

12 

7;^ 

83 

98<+ 

12 

7:3 

db 

985 

12 

7:3 

91 

986 

12 

7:3 

04 

987 

12 

7:4 

11 

988 

12 

7:5 

14 

989 

12 

7:5 

30 

990 

12 

7:4 

41 

991 

12 

7:3 

44 

992 

12 

7m- 

49 

993 

12 

7:5 

59 

99tf 

12 

7:5 

66 

995 

12 

7:6 

73 

996 

12 

7:7 

73 

997 

12 

718 

81 

998 

12 

7:9 

81 

999 

12 

7:9 

97 

1000 

12 

7:9 

15 

1001 

12 

7:8 

21 

1002 

12 

7:7 

23 

1003 

12 

7:6 

26 

100'+ 

12 

7:5 

29 

1005 

12 

7:4 

29 

1006 

12 

7:3 

32 

1007 

12 

7:2 

54 

1008 

12 

7:1 

54 

1009 

12 

7:1 

76 

1010 

12 

7:1 

89 

1011 

12 

7:1 

03 

1012 

12 

7:1 

19 

1013 

12 

7:1 

31 

101'+ 

12 

7:2 

35 

1015 

12 

7:3 

55 

1016 

12 

7:'+ 

63 

1017 

12 

7:5 

79 

1018 

12 

7:3 

83 

1019 

12 

7:3 

89 

1020 

12 

7:^ 

94 

1021 

12 

7:5 

08 

1022 

12 

7:i+ 

19 

NEXT  :=  Hlli     FISPACKD  :=  FALSE 
END; 
GOTTAGNAftflE  :=  FALSE;  PKTERR  ;=  FALSE; 
SEARCHID(CTYPES:,LCP1) ;  PRTERR  :=  TRUE; 
IF  LCPl  =  NIL  THEN 

BEGIN  GOTTAGNAME  :=  TRUE5 

LCP-^.NAME  :=  ID;  ENTERID(LCP);  INSYMBOL; 
IF  SY  =  COLON  THEN  INSYMBOL  ELSE  ERR0R(5) 

end; 

IF  SY  =  IDENT  THEN 

BEGIN  SEARCHID(CTYPES3«LCP1) ; 
LSPl  ;=  LCPl'^.IDTYPEJ 
IF  LSPl  <>  NIL  THEN 
BEGIN 

IF  LSPl'^.FORM  <=  SUBRANGE  THEN 
BEGIN 

IF  C0MPTYPES(REALPTR,LSP1)  THEN  ERROR(109)» 
LCP'^.IDTYPE  :=  LSPl?  LSP'^.TAGFIELDP  :=  LCPl 
IF  GOTTAGNAME  THEN  ALLOCATEiLCP) 
END 
ELSE  ERROR(llO) 

end; 
insymbol 

END 

ELSE  BEGIN  ERR0R(2);  SKIP(FSYS  +  C0FSY,LPARENT3)  END 

END 

ELSE  BEGIN  ERR0R(2);  SKIP(FSYS  +  C0FSY«LPARENT3)  END; 

LSP'^.SIZE  :=  DISPL  +  ORD(NEXTBIT  >  0); 

IF  SY  =  OFSY  THEN  INSYMBOL  ELSE  ERR0R(8); 

LSPl  :=  NIL;  MINSIZE  :=  DISPL;  MaxSIZE  5=  DISPLI 

MINBIT  ;=  NEXTBIT;  MAXBIT  :=  NEXTBIT; 

REPEAT  LSP2  :=  NIL; 

REPEAT  CONSTANT(FSYS  +  CC0MMA,C0L0N,LPARENT3f LSP3,LVALU) J 
IF  LSP'^.TAGFIELDP  <>  NIL  THEN 

IF  NOT  C0MPTYPES(LSP".TAGFIELDP-,IDTYPE.LSP3J  THEN 
ERROR(Hl)  ; 

new(lsp3, variant) ; 
with  lsps*"  do 

begin  nxtvar  :=  lspl;  subvar  1=  lsp2; 
varval  :=  lvalu;  form  :=  variant 

end; 
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1023 

12 

7:3 

21 

102*+ 

12 

7:3 

65 

1025 

12 

7:3 

33 

1026 

12 

7:2 

42 

1027 

12 

7:2 

i+S 

1028 

12 

7:2 

62 

1029 

12 

7:2 

76 

1030 

12 

7:2 

61 

1031 

12 

7:3 

87 

1032 

12 

7:2 

03 

1033 

12 

7:3 

12 

103t 

12 

7:2 

21 

1035 

12 

7:3 

26 

1036 

12 

7:<+ 

43 

1037 

12 

7:2 

49 

1038 

12 

7:3 

56 

10  39 

12 

7:«+ 

72 

lOtO 

12 

7:if 

85 

lOfl 

12 

7:3 

85 

10f2 

12 

7:2 

93 

10**3 

12 

7:3 

98 
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12 

7:tf 

01 

lOfS 

12 

7:5 

15 

10<^6 

12 

7:3 

33 

10H7 

12 

7:2 

33 

1048 

12 

7:2 

39 

1049 

12 

7:2 

44 

1050 

12 

7:3 

48 

1051 

12 

7:'+ 

51 

1052 

12 

7:3 

57 

1053 

12 

7:1 

63 

105'* 

12 

7:1 

70 

1055 

12 

7:1 

82 

1056 

12 

7:0 

87 

1057 

12 

7:0 

12 

1058 

12 

5:0 

0 

1059 

12 

5:1 

0 

1060 

12 

5:1 

9 

1061 

12 

5:2 

21 

1062 

12 

5:1 

43 

1063 

12 

5:2 

48 

LSPl  :=  LSP3;  LSP2  :=  LSP35 

TEST  :=  sY  <>  comma; 

IF  NOT  TEST  THEN  INSYMBOL 
UNTIL  TEST; 

IF  SY  =  COLON  THEN  INSYM30L  ELSE  ERR0R(5); 
IF  SY  =  LPaRENT  THEN  INSYMBOL  ELSE  ERR0R(9); 
IF  SY  =  RPARENT  THEN  LSP2  :=  NIL 
ELSE 

FIELDLIST(FSYS  +  CRPARENT«SEMIC0L0N3tLSP2) ? 
IF  DISPL  >  MAXSIZE  THEN 

BEGIN  MAXSIZE  :=  DISPL;  MAXBIT  :=  NEXTBIT  END 
ELSE 

IF  (DISPL  =  MAXSIZE)  AND  (NEXTBIT  >  MAXBIT)  THEN 
MAXBIT  :=  NEXTBIT! 
WHILE  LSP3  0  NIL  DO 

BEGIN  LSP4  :=  LSP3'*.SUBVAR;  LSP3'",SUbVAR  :=  LSP2; 

lsp3'*,size:  :=  displ  +   ord(nextbit  >  O); 

LSP3  :r  LSP4 

end; 

IF  SY  =  RPaRENT  THEN 
BEGIN  INSYMBOL; 

IF  NOT  (SY  IN  FSYS  +  CSEMIC0L0N3)  THEN 

BEGIN  ERR0R(6);  SKIPCFSYS  +  CSEMIC0L0N3)  END 
END 
ELSE  ERR0R(4); 
TEST  :=  SY  <>  SEMICOLON? 
IF  NOT  TEST  THEN 
BEGIN  INSYMBOL? 

DISPL  :=  MINSIZE?  NEXTBIT  :=  MINBIT 
END 
UNTIL  (TEST)  OR  (SY  =  ENDSY)?  (*  ««  SMF  2-28-78  *) 

displ  :=  MAXSIZE;  nextbit  :=  maxbit? 

LSP'^.FSTVAR  :=  LSPl 
END  (*VARIANTLIST*)  ; 

BEGIN  (*FIELDLIST*) 

nxti  :=  NIL?  LSP  :=  nil;  last  :=  nil; 

IF  NOT  (SY  IN  CiDENTtCASESYD)  THEN 

BEGIN  ERR0R(19)!  SKIP(FSYS  +  C IDENTiCASESYD ) 

WHILE  SY  =  IDENT  DO 
BEGIN  NXT  :=  NXTl! 
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end; 
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51 
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12 
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51 
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12 

5:5 
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12 
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1068 

12 
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66 
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73 
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12 
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76 

1071 
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12 

5:7 

04 
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12 

5:6 

06 

1074 

12 

5:6 

09 

1075 

12 

5:6 

13 

1076 

12 

5:5 

13 

1077 

12 

5:4 

16 

1078 

12 

5:4 

22 

1079 

12 

5:5 

29 

1080 

12 

5:4 

51 

1081 

12 

5:4 

56 

1082 

12 

5:3 

60 

1083 

12 

5:3 

66 

1084 

12 

5:3 

80 

1085 

12 

5:3 

02 

1086 

12 

5:4 

07 

1087 

12 

5:3 

17 

1088 

12 

5:4 

22 

1089 

12 

5:5 

25 

1090 

12 

5:6 

34 

1091 

12 

5:6 

44 

1092 

12 

5:5 

44 

1093 

12 

5:3 

51 

1094 

12 

5:3 

54 

1095 

12 

5:4 

59 

1096 

12 

5:5 

62 

1097 

12 

5:6 

75 

1098 

12 

5:4 

97 

1099 

12 

5:2 

97 

1100 

12 

5:1 

99 

1101 

12 

5:i 

02 

1102 

12 

5:2 

07 

1103 

12 

5:3 

10 

1104 

12 

5:1 

29 

REPEAT 

IF  SY  =  IDENT  THEN 

BEGIf\l 

if  packing  then  new { lcp , field, true ) 
else  new(lcp, field. false) ; 
«iith  lcp'*  do 

BEGIN  NAME  :=  ID;  IDTYPE  :=  NIL;  NEXT  :=  NXT; 
KLASS  :=  FIELD;  FISPACKD  :=  FALSE 

END! 

NXT  :=  Lcp; 

ENTERID(LCP) ; 

INSYMBOL 
END 
ELSE  ERR0R(2) ; 
IF  NOT  (SY  IN  CCOMMA.COLOND)  THEN 

rrcr"-  ES^S^^J'i  SKIPCFSYS  +  CCOMMA, COLON, SEMICOLON. CASESY3) 
ILoi  »—  SY  v>  COMMA; 

IF  NOT  TEST   THEN  INSYMBOL 
UNTIL  TEST; 

IF  SY  =  COLON  THEN  INSYMBOL  ELSE  ERR0R(5); 
TYP(FSYS  +  CCASESY,SEMIC0L0N3»LSP,LSIZE); 
IF  LSP  0  NIL  THEN 

IF  LSP'^.FORM  =  FILES  THEN  ERROR(108); 
WHILE  NXT  0  NXTl  DO 
WITH  NXT*^  DO 

BEGIN  IDTYPE  :=  LSP;  ALLOCATE (NXT) ; 
IF  NEXT  =  NXTl  THEN  LAST  :=  NXT; 
NXT  :=  NEXT 

end; 
NXTl  :=  Lcp; 

IF  SY  =  SEMICOLON  THEN 
BEGIN  INSYMBOL; 

^^Jnl    ^fl    ^^    I:iDENT,ENDSY,CASESY3)  then  (♦  ««  SMF  2-28-78 
BEGIN  ERR0R(19);  SKIP(FSyS  +  C IDENTtCASESYJ)  END 
END 
END  {*WHILE*); 

NXT  :=  nil; 

WHILE  NXTl  <>  NIL  DO 
WITH  NXTl**  DO 

BEGIN  LCP  :=  NEXT;  NEXT  :=  NXT;  NXT  :=  NXTl;  NXTl  :=  LCP  FwD* 
IF  SY  =  CASESY  THEN  VARIANTLIST  ' 


end; 


*) 
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12 

5:i 

5^+ 
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12 

b:o 

39 
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12 

5:o 

64 

1108 

12 

&:q 

1 

1109 
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0 
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12 
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13 

1111 

12 
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18 
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12 
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31 
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12 
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iim 

12 
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39 

1115 

12 

a:3 

«+2 

1116 

12 

8:3 

55 

1117 

12 

8:^ 

62 

1118 

12 

8:5 

68 

1119 

12 

8:6 

73 

1120 

12 

8:7 

85 

1121 

12 

816 

94 

1122 

12 

8:5 

96 

1123 

12 

8:4 

96 

112'f 

12 

8:3 

01 

1125 

12 

8:i 

03 

1126 

12 

8:5 

03 

1127 

12 

8:6 

11 

1128 

12 

8:7 

23 

1129 

12 

8:6 

31 

1130 

12 

8:1^ 

36 

1131 

12 

8:3 

39 

1132 

12 

e:2 

42 

1133 

12 

8:1 

42 

113^ 

12 

8:0 

45 

1135 

12 

8:0 

60 

1136 

12 

2:0 

0 

1137 

12 

2:1 

0 

1138 

12 

2:1 

3 

1139 

12 

2:2 

13 

1140 

12 

2:1 

33 

ll'+l 

12 

2:2 

42 

1142 

12 

2:3 

42 

ll'+3 

12 

2:3 

60 

ll'tf 

12 

2:ti 

64 

11^5 

12 

2:^+ 

69 

ELSE  FRECVAR  :=  NIL 
END  (*FIELDLIST*)  ; 

PROCEDURE  POINTErTYPE; 

BEGIN  NEW(LSPtPOlNTER) 5  FSP  :=  LSP; 

with  lsp"  do 

3egin  eltype  :=  nil;  size  :=  ptrsize;  form  :=  pointer  end; 
insymbol; 
if  sy  =  ident  then 

BEGIN  PRTERR  :=  FALSE; 

SEARCHID(CTYPES3.LCP) ;  PRTERR  :=  TRUE; 
IF  LCP  =  NIL  THEN    (*FORWARD  REFERENCED  TYPE  ID*) 
BEGIN  NEW(LCP, TYPES); 
WITH  LCP**  DO 

BEGIN  NAME  :=  10;  IDTYPE  :=  LSP; 

NEXT  :=  fwptr;  klass  :=  types 

END; 
fwptr  :=  LCP 

END 
ELSE 
BEGIN 

IF  LCP'^. IDTYPE  0  NIL  THEN 

IF  (LCP". IDTYPE**. FORM  <>  FILES)  OR  SYSCOMP  THEN 

LSP". ELTYPE  :=  LCP". IDTYPE 
ELSE  ERRORdOB) 

end; 
insymbol; 

END 
ELSE  ERR0R(2) 
END  (*POINTERTYPE*)  ; 

BEGIN  (*TYP*) 

PACKING  :=  FALSE; 

IF  NOT  (SY  IN  TYPEBEGSYS)  THEN 

BEGIN  ERRORdO)'  SKIP(FSYS  +  TYPEBEGSYS)  END; 
IF  SY  IN  TYPEBEGSYS  THEN 
BEGIN 

IF  SY  IN  SIMPTYPEBEGSYS  THEN  SIMPLETYPE ( FSYS ,FSP»FSIZE ) 
ELSE 
(*"*)    IF  SY  =  ARROW  THEN  POINTERTYPE 
ELSE 
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I  If  6 

n't? 

ll'+8 
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1151 

1152 

1153 
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12 

12 
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73 
73 

78 

94 
14 
14 
19 
22 
36 
39 
39 
47 
54 
57 
69 
78 
88 

90 

93 

14 

17 

22 

28 

28 

34 

41 

43 

48 

57 

60 

62 

71 

76 

80 

86 

00 

14 
27 
32 
42 


TYPEDELS)  END 


BEGIN 

IF  SY  =  PACKEDSY  THEN 

BEGif^j  insymbol;  packing  :=  true; 

IF  NOT  (SY  IN  TYPEDELS)  THEN 
BEGIN  ERROR(IO);  SKIP(FSYS  + 
END? 

(♦ARRAY*)    IF  SY  =  ARRAYSY  THEN 
BEGIN  INSYMBOL; 

IF  SY  =  LBRACK  THEN  INSYMBOL  ELSE  ERROR(ll); 

LSPl  :=  NIL; 

REPEAT 

IF  PACKING  THEN  NEW (LSPt ARRAYS* TRUE. FALSE) 
ELSE  NEWCLSP. ARRAYS, FALSE) J 
WITH  LSP'*  DO 

BEGIN  AELTYPE  :=  LSPl ?  INXTYPE  :=  NIL; 

IF  PACKING  THEN  AISSTRNG  1=  FALSE; 

AISPACKD  :=  FALSE!   FORM  :=  ARRAYS 
END; 
LSPl  :=  LSP; 

LSPli^fllzr^rfsi  ^^°""*''^^'''^^*<'0''SY3,LSP2,LSIZE)  J 
IF  LSP2  <>  NIL  then' 

IF  LSP2^,F0RM  <=  SUBRANGE  THEN 
BEGIN 

IF  LSP2  =  REALPTR  THEN 

BEGIN  ERROR(109);  LSP2  :=  NIL  END 
ELSE 

IF  LSP2  =  INTPTR  THEN 

BEGIN  ERR0R(149);  LSP2  :=  NIL  END; 
LSP'^. INXTYPE  :=  LSP2 
END 

ELSE  BEGIN  ERR0R(113);  LSP2  :=  NIL  END? 
TEST  ;=  SY  <>  COMMA; 
IF  NOT  TEST  THEN  INSYMBOL 

UNTIL  test; 

IF  SY  =  RBRACK  THEN  INSYMBOL  ELSE  ERR0R(12)I 
IF  SY  =  OFSY  THEN  INSYMBOL  ELSE  ERR0R(8); 
TYP(FSYS»LSP,LSIZE); 
IF  LSP  0  NIL  THEN 

IF  LSP-.FORM  =  FILES  THEN  ERROR(108); 
IF  PACKABLE(LSP)  THEN 
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12 

2:9 
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12 
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12 

2:2 

76 
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12 
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04 

1198 
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2:3 

14 
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19 
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12 

2:h 

26 

1201 

12 
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(♦RECORD* 
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12 
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IF  NUMBITS  +  NUMBITS  <=  BITSPERWD  THEN 
WITH  LSPl'*  DO 

BEGIN  AISPACKD  :=  TRUE; 

ELSPERi/JD  :=  BITSPERWD  DIV  NUMBITS; 
ELWIDTH  :=  NUMBITS 
END; 
REPEAT 

WITH  LSPl^  DO 

BEGIN  LSP2  :=  AELTYPE;  AELTYPE  :=  LSP; 
IF  INXTYPE  <>  NIL  THEN 

BEGIN  GETBOUNDS(INXTYPEfLMINfLMAX) ; 
IF  AISPACKD  THEN 

LSIZE  :=  (LMAX-LMIN+ELSPERWD) 

DIV  ELSPERWD 
ELSE 

LSIZE  :=  LSIZE*(LMAX  -  LMIN  +  1)5 
IF  LSIZE  <=  0  THEN 

BEGIN  ERR0R{398);  LSIZE  ;=  1  END; 
SIZE  :=  LSIZE 
END 
END; 
LSP  :=  LSPl;  LSPl  :=  LSP2 
UNTIL  LSPl  =  NIL 
END 
ELSE 

IF  SY  =  RECORDSY  THEN 
BEGIN  INSYMBOL; 
OLDTOP  :=  TOP; 
IF  TOP  <  DISPLIMIT  THEN 
BEGIN  TOP  :=  TOP  +  i; 
WITH  DISPLAYCTOPD  DO 

BEGIN  FNAME  !=  NIL;  OCCUR  :=  REC  END 
END 
ELSE  ERROR(250)I 
DISPL  :=  0;  NEXTBIT  :=  0; 

FlELDLlST(FSYS-CSEMIC0L0N3+CENDSYDfLSPl); 
DISPL  :=  DISPL  +  0RD(NEXTBIT  >  0); 
NEW(LSPtRECORDS) ; 
WITH  LSP"  DO 

BEGIN  FSTFLD  :=  DISPLAYCT0P3. FNAME ; 
RECVAR  :=  LSPi;  SIZE  :=  DISPL; 
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(*SET*) 
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33 
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00 
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16 

THErg    KnISYMBOL    ELSE    ERR0R{13) 


FORM    :=    RECORDS 
tND; 
TOP    :=    OLDTOP; 
IF    SY    =    ENDSY 

ErviD 

ELSE 

IF  SY  =  SETSY  THEN 
BEGIN  INSYM30L; 

IF  SY  =  OFSY  THEN  INSYMBOL  ELSE  ERR0R(8); 

SIMPLETYPECFSYStLSPl.LSIZE); 

IF  LSPl  <>  NIL  THEN 

IF  (LSPl'^.FORM  >  SUBRANGE)  OR 

(LSPl  =  INTPTR)  OR  (LSPl  =  REALPTR)  THEN 
BEGIN  ERR0R(115);  LSPl  :=  NIL  END 
ELSE 

IF  LSPl  =  REALPTR  THEN 

BEGIN  ERR0R(114);  LSPl  :=  NIL  END? 
NEW(LSP, POWER) ; 
WITH  LSP*  DO 

BEGIN  ELSET  ;=  LSPl;  FORM  :=  POWER? 
IF  LSPl  0  NIL  THEN 

BEGIN  GETB0UNDS(LSP1»LMIN»LMAX); 

SIZE  :=  (LMAX  +  BITSPERWD)  DIV  BITSPERWO; 
IF  SIZE  >  255  THEN 

BEGIN  ERR0R(169)|  SIZE  :=  1  END 
END 
ELSE  SIZE  :=  0 
END 
END 
ELSE 

IF  SY  =  FILESY  THEN 
BEGIN 

IF  INMODULE  THEN 

IF  NOT  ININTERFACE  THEN 

ERR0R(191);  (*N0  PRIVATE  FILES*) 
INSYMBOL;  NEW{LSP,FILES) J 
WITH  LSP'*  00 

BEGIN  FORM  :=  FILES;  FILTYPE  :=  NIL  END} 
IF  SY  =  OFSY  THEN 

BEGIN  INSYMBOL;  TYP(FSYS»LSP1 ,LSIZE)  END 
ELSE  LSPl  :=  NIL; 
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LSP'^.FILTYPE  :=  LSPl; 
IF  LSPl  <>  NIL  THEN 

LSP'^.SIZE  :=  FILESIZE  +  LSPl'^.SIZE 
ELSE  LSP'^.SIZE  :=  NILFILESIZE 
END; 
FSP  :=  LSP 

end; 
if  not  (sy  in  fsys)  then 
begin  err0r(6);  skip(fsys)  end 

ENo 

ELSE  FSP  :=  nil; 

IF  FSP  =  NIL  THEN  FSIZE  :=  1  ELSE  FSIZE  :=  FSP**. SIZE 
END  (*TYP*)  ; 

*$i  <*5:decpart.a.text*) 
*si  «5:decpart.b.text*) 
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PROCEDURE  USESDECLARATION{MAGIC:  BOOLEAN); 
LABEL  1; 
TYPE  DCREC  =  RECORD 

DISKADDR:  INTEGERS 
CODELENG:  INTEGER 
END! 
VAR  SEGDICT:  RECORD 

DANDC:  ARRAYCSEGRAN6E3  OF  DCREC; 
SEGNAME:  ARRAYCSEGRANGEa  OF  ALPHA} 
SEGKIND:  ARRAYCSEGRANGE3  OF  INTEGER; 
TEXTADDR:  ARRAYCSEGRANGE3  OF  INTEGER; 
FILLER:  ARRAYC0..127D  OF  INTEGER 
END! 

found:  booleian!  begaddr:  integer! 

lcp:  ctp;  llexstk:  lexstkrec;  lname:  alpha; 

lsy:  SYMBOL!  LOp:  operator;  lid:  alpha; 

PROCEDURE  GETTEXT(VAR  FOUND:  BOOLEAN)! 
VAR  lcp:  CTP;  SEGINDEX:  INTEGER! 

BEGIN  FOUND  :=  FALSE; 

LcP  :=  modptr; 
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47 
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47 
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51 
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12 
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54 
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34 
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WHILE  (LCP  0  NIL)  AND  NOT  FOUND  DO 

IF  LCP-.NAME  =  ID  THEN  FOUND  :=  TRUE  ELSE  LCP  :=  LCP^.NEXT; 

IF  FOUND  THEN 
3EGIN 

LSEPPROC  :=  SEGTABLECLCP-.SEGID3.SEGKIND  =  4; 
IF  NOT  LSEPPROC  THEN 

BEGIN  SEG  :=  LCP'^.SEGID;  NEXTPROC  :=  1  END; 
BEGADDR  :=  SEGTABlECLCP'^,  SEGID3.TEXTADDR  : 
USEFILE  :=  WORKCODE; 
END 
ELSE 

BEGIN  FOUND  :=  TRUE; 
IF  LIBNOTOPEN  THEN 

BEGIN  RESET(LIBRARYfSYSTEMLIB); 

IF  lORESULT  <>  0  THEN  BEGIN  ERR0R{187);  FOUND  ;=  FALSE  END 

IF  BLOCKREAD(HBRARY»SEGDlCT.ltO)  <>  1  THEN 
BEGIN  ERR0R(187);  FOUND  :=  FALSE  END? 
ENDI 
IF  FOUND  THEN 

BEGIN  LIBNOTOPEN  :=  FALSE; 

SEGINDEX  !=  0;  FOUND  :=  FALSE; 
WHILE  (SEGINDEX  <=  MAXSEG)  AND  (NOT  FOUND)  DO 
IF  MA6IC  THEN 

IF  SEGDICT.SEGNAMECSEGINDEX3  =  LNAME  THEN  FOUND  :=  TRUE 
ELSE  SEGINDEX  :=  SEGINDEX  +  1 
ELSE 

IF  SEGDICT.SEGNAMECSEGINDEX3  =  ID  THEN  FOUND  is  TRUE 
ELSE  SEGINDEX  :=  SEGINDEX  +  i; 
IF  FOUND  THEN 

BEGIN  USEFILE  :=  SYSLIBRARY; 

BEGADDR  :=  SEGDICT.TEXTADDRCSEGlNDExa; 
LSEPPROC  :=  SEGDICT.SEGKINDCSEGINDEX3  =  4; 
IF  NOT  LSEPPROC  THEN 
BEGIN 

IF  MAGIC  THEN  SEG  :=  6 
ELSE 

BEGIN  SEG  :=  nextseg; 
NEXTSEG  ;=  NEXTSEG  +  1; 
IF  NEXTSEG  >  MAXSEG  THEN  ERR0R(250) 
END; 
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GO 

WITH  SEGTA3LECSEG]  DO 

BEGIN  OISKADDR  :=  0;  CODELENG  :=  0! 

SEGNAME  :=  SEG0ICT.SEGNAMECSEGINDEX3; 
IF  INMODULE  OR  MAGIC  THEN  SEGKIND  :=  0 
ELSE  SEGKIND  :=  SEGDiCT.SEGKINDCSEGINDEXi; 
TEXTADDR  :=  0 
END; 
NEXTPROC  :=  1 
END 

END 
ELSE  ERROR(190)  (♦NOT  IN  LIBRARY*) 

END 

end; 
if  begaddr  =  0  then  begin  errqr(195);  found  :=  false  end? 
if  found  then 

BEGIN 

USING  :=  TRUE; 

PREVSYMCURSOR  :=  SYMCURSOR; 

PREVLINESTART  :=  LINESTARTJ 

PREVSYM8LK  :=  SYMBLK  -  2» 

SYMBLK  :=  BEGADDR;  GETNEXTPAGE? 

INSYMBOL 
END 
END  (*GETTEXT*)  ; 

BEGIN  («USESDEClaRATION«) 

IF  LEVEL  <>  1  THEN  ERR0R(189); 

IF  INMODULE  AND  NOT  ININTERFACE  THEN  ERR0R(192); 

IF  NOT  MAGIC  THEN  DLlNKERINFO  :=  TRUE; 

IF  NOT  USING  THEN  USINGLIST  ;=  NIL; 

REPEAT 

IF  (NOT  MAGIC)  AND  (SY  <>  IDENT)  THEN  ERR0R(2) 
ELSE 

IF  USING  THEN 

BEGIN  LCP  :=  USINGLIST; 
WHILE  LCP  0  NIL  DO 

IF  LCP''. NAME  =  ID  THEN  GOTO  1 
ELSE  LCP  :=  lcp'^.next; 

ERR0R(188) (*UnIT  MUST  BE  PREDECLARED  IN  MAIN  PROG*); 
1: 

END 
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:=  'TURTLE 

LOP  :=  op; 


'  i 

LID 


:=  ID 


;=  10 


WRITELN(QUTPUT,ID, 
iSCREEND0TS:4i •>♦ ) 


;=  seg;  soldproc  :=  nextproc  end; 


ELSE 
BEGIN 

IF  MAGIC  TtlEN 
BEGIN  LNAME 

LSY  :=  SY 

END 
ELSE 

BEGIN  LNAME 

WRITELN(OUTPUT) ; 
WRlTE(OUTPUTt •<• 
END; 
WITH  LLEXSTK  DO 
BEGIN  DOLDSEG 
GETTEXT(FOUND) ; 
IF  FOUND  THEN 
BEGIN 

NEW(LCP, MODULE); 
WITH  LCP'^  DO 

BEGIN  NAME  :=  LNAME;  NEXT  :=  USINGLIST; 
IDTYPE  :=  NIL;  KLASS  :r  MODULE; 
IF  LSEPPROC  THEN  SEGID  :=  -1  (♦NO  SEG*) 
END; 

ENTERID(LCP) ; 

USINGLIST  :=  LCP; 

DECLARATI0NPART(FSYS  +  CENDSYD); 

IF  NEXTPR0C=1  (♦NO  PROCS  DECLARED*)  THEN 

LCP*". SEGID  :=  -1;  (*N0  SEG*) 
SYMBLK  :=  9999;  (♦FORCE  RETURN  TO  SOURCEFILE*) 
GETNEXTPAGE 
END; 

if  not  lsepproc  then 
with  llexstk  do 
begin  seg  :=  doldseg; 

nextproc  :=  soldproc 
end; 
LSEPPROC  :=  false; 
end; 
if  not  magic  then 
begin  insymbol; 

TEST  :=  SY  0 
IF  TEST  THEN 


C'.MEMAVAIL:5t»  WORDSJM 


ELSE  SEGID  :=  SEG 


COMMA; 
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INSYMBOL  ELSE  ERR0R(14) 

:=  LOP;  ID  :=  lid  end; 


IF    SY    <>    SEMICOLO'nJ    THEN    t.RROR(20) 
ELSE 
ELSE    IfMSYMBOL 

lno 
until  test  or  magic; 
if  not  i'jiagic  then 
if  sy  =  semicolon  then 

ELSE  BEGIN  SY  :=  LSY;  OP 
IF  NOT  USING  THEN 
BEGIN 

IF  INMODULE  THEN  USINGLIST  :=  NIL; 
CLOSE(LIBRARY,LOCK) ; 
LIBNOTOPEN  :=  TRUE 
END 
END  (♦USESDECLARATION*)  i 

PROCEDURE  LABELDECLARATIOn; 

VAR  LLP:  labelp;  redef:  boolean; 

BEGIN 
REPEAT 

IF  SY  =  INTCONST  THEN 
WITH  DISPLAYCTOPD  DO 

BEGIN  LLP  :=  FLABEL;  REDEF  ;=  FALSE; 
WHILE  (LLP  <>  NIL)  AND  NOT  REDEF  DO 
IF  LLP'^.LABVAL  <>  VAL.IVAL  THEN 

LLP  :=  LLP^.NEXTLAB 
ELSE  BEGIN  REDEF  :=  TRUE;  ERR0R(166)  END; 
IF  NOT  REDEF  THEN 
BEGIN  NEW(LLP) ; 
WITH  LLP*^  DO 

BEGIN  LA8VAL  :=  VAL.IVAL; 

CODELBP  :=  nil;  nextlab  :=  flabel 

END; 
FLABEL  :=  LLP 
END; 
INSYMBOL 
END 
ELSE  ERR0R(15) 5 
IF  NOT  (  SY  IN  FSYS  +  CCOMMA*  SEMICOLOND  )  THEN 

BEGIN  ERR0R(6) ;  SKIP(FSYS+CC0MMA»SEMIC0L0ND)  END; 
TEST  :=  SY  <>  COMMA; 
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IF  NOT  TEST  THt-N  INSYMBOL 
UNTIL  TEST; 

IF  SY  =  SE.MICOLOIM  THEN  IMSYM30L  ELSE  ERR0R(14) 
END  (*  LABELDECLARATION  *)  ; 

PROCEDURE  CONSTDECLARATION; 

VAR  lcp:  CTP;  LSP;  stp;  lvalu:  valu; 

BEGlM 

IF  sY  <>  IDENT  THEN 

3EGIN  ERROR(2)5  SKlP(FSYS  +  CIDENTD)  END; 
WHILE  SY  =  IDENT  DO 
3EGIN  NEW(LCPiKONST) ; 
WITH  LCP-^  DO 

BEGIN  NAME  :=  ID;  IDTYPE  :=  NIL; 

NEXT  :r  NIL;  KLaSS  :=  KONST 
END; 

insymbol; 

IF  (SY  =  RELOP)  AND  (OP  =  EOOP)  THEN  INSYMBOL  ELSE  ERRORdfi); 

C0NSTANT(FSYS  +  CSEMICOLOND.LSP.LVALU);  tn«u«(i6M 

ENTERID(LCP); 

LCP'^. IDTYPE  :=  LSP;  LCP-. VALUES  !=  LVALU; 

IF  SY  =  SEMICOLON  THEN 

BEGIN  insymbol; 

IF  NOT  (SY  iH    FSYS  +  CIDENTD)  THEN 

BEGIN  ERR0R(6);  SKIP(FSYS  +  CIDENT3)  END 

END 
ELSE 

IF  NOT  ((SY  =  ENDSY)  AND  (INMODULE))  THEN  ERRORdt) 

END  (*CONSTDECLARATION*)  ; 
PROCEDURE  TYPEDECLARATION; 

VAR  LCP,LCP1,LCP2:  cTp;  lsp:  stp;  lsize:  addrrange; 

oEGiN 

IF  sr  0  IDENT  THEN 

BEGIN  ERR0R{2)!  SKIP(FSYS  •••  CIDENTD)  END; 
WHILE  SY  =  IDENT  DO 
3EGIN  NEW(LCPiTYPES) ; 
WITH  LCP'*  DO 

BEGIN  NAME  :=  ID;  IDTYPE  :=  NIL;  KLASS  :=  TYPES  END; 
INSYMBOL ; 
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IF  (SY  -    RELOP)  AND  (OP  =  EQOP)  THEN  INSYMBOL  ELSE  ERR0R(16); 
TYP(FSYS  +  [:SEMlC0L0N3iLSP,LSlZE)  ! 
ENTERIO(LCP) ; 

lcp'^.idtype  :=  Lsp; 
LCPi  :=  fwptk; 

WHILE  LCPl  <>  NIL  DO 
BEGIN 

IF  LCPl''. NAME  =  LCP'^.NAME  THEN 
3EGIN 

LCPl'^.IOTYPE^.ELTYPE  :=  LCP'*.  IDTYPE  ; 
IF  LCPl  <>  FWPTR  THEN 

LCP2'^.NEXT  :=  LCPl''. NEXT 
ELSE  FWPTR  :=  LCPl'^.NEXT; 
END; 

LCP2  :=  Lcpi;  LCPl  :=  lcpi^.next 
end; 
if  sy  =  semicolon  then 
begin  insymbol! 
if  not  (sy  in  fsys  +  cidentd)  then 
begin  err0r(6);  skip(fsys  +  cident3)  end 

END 
ELSE 

if  not  ((sy  =  endsy)  and  (inmodule))  then  err0r(14) 
end; 
if  fwptr  <>  nil  then 

BEGIN  ERR0R(117);  FWPTR  :=  NIL  END 
END  (*TYPEDECLARATI0N*)  ; 

PROCEDURE  VARDECLARATION; 

VAR  LCPtNXTtlDLlST:  CTP;  LSP:  STP;  LSIZE:  ADDRRANGE! 
BEGIN  NXT  :=  NIL! 
REPEAT 
REPEAT 

IF  SY  =  IDENT  THEN 
BEGIN 

IF  INMODULE  THEN  NEW { LCPiACTUALVARS. TRUE) 
ELSE  NEW(LCP, ACTUALVARS, FALSE) ; 
WITH  LCP'^  DO 
BEGIN  NAME  :=  ID;  NEXT  :=  NXT;  KLASS  :=  ACTUALVARS; 

IDTYPE  :=  nil;  vlev  :=  level; 

IF  INMODULE  THEN 
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if  ininterface  then  public  :=  true 
else  public  :=  false 

end; 

Ef\iTERlD(LCP)  ; 
NXT    ;=    LCP; 

insymbol; 

END 
ELSE  ERR0R{2) ; 
IF  NOT  (SY  IN  FSYS  +  CCOMMAtCOLOND  +  TYPEDELS)  THEN 

BEGIN  ERR0R{6);  SKIP ( FSYS+CCOMMA .COLONt SEMICOLOND+TYPEDELS)  END} 

TEST  :=  SY  <>  COMMA; 

IF  NOT  TEST  THEN  INSYMBOL 
UNTIL  test; 

IF  SY  =  COLON  THEN  INSYMBOL  ELSE  ERR0R(5); 
IDLIST  :=  NXT! 

TYP(FSYS  +  CSEMICOLOND  +  TYPEDELS, LSP, LSIZE) ; 
WHILE  NXT  0  NIL  DO 
WITH   NXT'*  DO 

BEGIN  lOTYPE  :=  LSP;  VAODR  :=  LC; 

Lc  :=  LC  +  lsize;  nxt  :=  next; 

IF  next  =  nil  THEN 

if  LSP  0  nil  then 

if  LSP'*. FORM  =  FILES  THEN 

BEGIN  {*PUT  IDLIST  INTO  LOCAL  FILE  LIST*) 

NEXT  :=  0ISPLAYCT0P3,FFILE; 

DISPLAYCTOPD.FFILE  :=  IDLIST 
END 

end; 
if  sy  =  semicolon  then 
begin  insymbol; 
if  not  (sy  in  fsys  +  cidentd)  then 
begin  err0r{6);  skip{fsys  +  cident3)  end 

END 
ELSE 

IF  NOT  (<SY  =  ENDSY)  AND  (INMODULE))  THEN  ERROR(ll) 
UNTIL  (SY  <>  IDENT)  AND  NOT  (SY  IN  TYPEDELS); 
IF  FWPTR  <>  NIL  THEN 

BEGIN  ERR0R(H7);  FWPTR  :=  NIL  END 
END  (♦VARDECLARATION*)  ; 
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3G6 

*?5:  jLCPAKT.a.  TEXT*) 
ttSrDECPART.C.TExT*) 

COPYRIGHT  (C)  1979,  REGENTS  OF  THE         *) 
UNIVERSITY  OF  CALIFORNIA*  SAN  DIEGO        *) 

PROCEDURE  PR0CDECLARATI0N(FSY:  symbol;  SEGDEC:  BOOLEAN); 

VAR  lsy:  symbol;  lcpiLCpi:  ctp;  lsp:  stp; 
extonlYiForw:  boolean; 
lcm:  addrrange; 
llexstk:  lexstkrec; 

procedure  parameterlist(FSy:  setofsys;  var  fpar:  ctp;  fcp:  ctp); 
vaR  LCP»LCPi»LCP2,LCP3:  CTP;  LSP:  stp;  lkind:  idkino; 

LLCLEN  :  ADDRRANGE;  COUNT  :  INTEGER; 
BEGIN  LCPl  :=  NIL;  LLC  :=  LC; 

IF  NOT  (SY  IN  FSY  +  CLPARENTD)  THEN 

BEGIN  ERR0R(7);  SKIPiFSYS  +  FSY  +  CLPARENTD)  END; 
IF  SY  =  LPARENT  THEN 

BEGIN  IF  FORM  THEN  ERR0R(119); 
INSYMBOL; 
IF  NOT  (SY  IN  CIDENT,VARSY3)  THEN 

BEGIN  ERR0R(7);  SKIPCFSYS  +  CIDENT.RPARENT:)  END; 
WHILE  SY  IN  CIDENT.VARSY]  DO 
BEGIN 

IF  SY  =  VARSY  THEN 

BEGIN  LKIND  :=  FORMAL;  INSYMBOL  END 
ELSE  LKIND  :=  ACTUAL; 
LCP2  :=  NIL; 
COUNT  J=  0; 
REPEAT 

IF  SY  0  IDENT  THEN  ERR0R(2) 
ELSE 
BEGIN 

NEW(LCP.FORMALVARS, FALSE);  (*MAY  BE  ACTUAL(SAME  SIZE)*) 
WITH  LCP**  DO 

BEGIN  NAME  :=  ID;  IDTYPE  :=  NIL;  NEXT  :=  LCP2; 
IF  LKItMD  =  FORMAL  THEN  KLASS  :=  FORMALVARS 
ELSE  KLASS  :=  ACTUALVARS;  VLEV  :=  LEVEL 
END; 
ENTERIO(LCP) ; 


1636 
1637 
1638 
1639 
1640 
16^+1 
1642 
1613 
16'+'+ 
1645 

le^+e 

1647 

la^+a 

1649 

1650 

1651 

1652 

1653 

1654 

1655 

1656 

1657 

1658 

1659 

1660 

1661 

1662 

1663 

1664 

1665 

1666 

1667 

1668 

1669 

1670 

1671 

1672 

1673 

1674 

1675 

1676 


12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 


16 
16 
16 
16 
16 

16:8 

16:7 

16:6 

16:6 

16:5 

16:5 

16:5 

16:6 

16:7 

16:8 

16:9 

16:9 

16:9 

16:9 

16:9 

i6:o 

i6:i 

I6:i 

16:2 

16:9 

16:8 

16:7 

16:6 

16:5 

16:6 

16:7 

16:6 

16:5 

16:6 

16:5 

16:5 

16:6 

16:7 

16:  a 

16:9 

16:8 


6b 

93 

93 

96 

10 

14 

25 

28 

33 

37 

43 

46 

51 

54 

59 

59 

68 

71 

75 

78 

83 

88 

95 

00 

10 

12 

17 

20 

23 

25 

30 

30 

40 

54 

72 

78 

83 

86 

89 

94 

94 


LCP2  :=  LCP;  COUNT  :=  COUNT  +  1; 
INSYf^BOL 
END; 

IF  NOT  (SY  IN  FSYS  +  C COMMA , SEMICOLON , COLONS )  THEN 
BEGIN  ERR0R(7) ; 

SKIP(FSYS  +  CCOMMA, SEMICOLON, RPARENT, colon:]) 
END  I 

TEST  :=  SY  <>  COMMA; 

IF  NOT  TEST  THEN  INSYMbOL 

UNTIL  test; 
LSP  :=  nil; 

IF  SY  =  COLON  THEN 
BEGIN  INSYMBOL; 

IF  SY  =  IDENT  THEN 
BEGIN 

SEARCHlD(CTYPESa,LCP) i 
INSYMBOL; 

LSP  :=  lcp'^.idtype; 
LEN  :=  ptrsize; 

IF  LSP  <>  NIL  THEN 

IF  LKIND  =  ACTUAL  THEN 

IF  LSP-.FORM  =  FILES  THEN  ERR0R(121) 
ELSE 

IF  LSP'', FORM  <=  POWER  THEN  LEN  :=  LSP'^.SIZE; 
LC  :=  LC  +  COUNT  *    LEN 
END 
ELSE  ERR0R{2) 
END 
ELSE 

IF  LKIND  =  FORMAL  THEN 

EXTONLY  :=  TRUE 
ELSE  ERR0R(5) • 
IF  NOT  (SY  IN  FSYS  +  CSEMICOLONtRPARENT])  THEN 
LCP3*^:=  LCP2?'^*'  SKIP(FSYS  +  CSEMICOLON.RPARENT:)  END; 

WHILE  LCP2  <>  NIL  DO 
BEGIN  LCP  :r  LCP2; 
WITH  LCPS''  DO 

BEGIN  IDTYPE  :=  LSP; 

LCP2  :=  NEXT 
END 
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cimd; 
if  lcp  <>  nil  then 

3EGIN  LCP'*. NEXT  :=  LCPi;  LCPl  :=  LCP3  END; 
IF  SY  =  SEMICOLON  THEN 
BEGIN  INSYMBOL; 

IF  NOT  (SY  IN  FSYS  +  C lOENT. VARSY3 )  THEN 

BEGIN  ERR0R(7);  SKIP(FSYS  +  C IDENT iRPARENT D )  END 
END 
END  (*WHILE*)  ; 
IF  SY  =  RPARENT  THEN 
BEGIN  INSYMBOL; 

IF  NOT  (SY  IN  FSY  +  FSYS)  THEN 

BEGIN  ERR0R(6);  SKIP(FSY  +  FSYS)  END 
END 
ELSE  ERRORtt); 

FCP'^.LOCALLC  :=  LC  J  LCP3  :=  NIL; 
WHILE  LCPl  <>  NIL  DO 
WITH  LCPl"  DO 

BEGIN  LCP2  :=  NEXT;  NEXT  :=  LCP3; 
IF  (IDTYPE  <>  NIL)  THEN 

IF  KLASS  =  FORMALVARS  THEN 

BEGIN  VADOR  :=  LLC;  LLC  :=  LLC  +  PTRSIZE  END 
ELSE 

IF  KLASS  =  ACTUALVARS  THEN 

IF  (IDTYPE'^. FORM  <=  POWER)  THEN 

BEGIN  VADDR  !=  LLC;  LLC  :=  LLC  +  IDTYPE". SIZE  END 
ELSE 

BEGIN  VADDR  :=  LC; 

Lc  :=  LC  +  idtype'^.size; 

LLC  :=  LLC  +  PTRSIZE 
END; 

LCP3  :=  LCPi;  LCPl  :=  lcp2 

END; 
FPAR  :=  LCP3 
END 

ELSE  FPAR  :=  NIL 
END  C+PARAMETERLIST*)  ; 

BEGIN  (*PROCDECLARATION*) 

IF  SEGDEC  THEN  (*  SEGMENT  DECLARATION  *) 

BEGIN 
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IF  CODEINSEG  THEN 

BEGIN  ERR0K(399);  SEGINX:=0;  CURBYTE:=0;  END; 
WITH  LLEXSTK  UO 

BEGIN 

doldseg:=seg; 
seg:=imextseg; 
s0ldpr0c:=nextpr0c; 

end; 

NEXTPROC:=i; 

lsy:=sy; 

if  sy  in  cprocsytfulmcsyd  then  insymbol 

ELSE  BEGIN  EHR0R(399);  LSY:=PR0CSY  END; 

fsy:=lsy; 
eno; 
llexstk. dllc  :=  lc ;  lc  :=  lcaftermarkstack; 

IF  FSY  =  FUNCSY  THEN  LC  :=  LC  +  REALSIZEJ 
LINEINFO  :=  LC;  DP  ;=  TRUE;  EXTONLY  1=  FALSE; 
IF  SY  =  IDENT  THEN 
BEGIN 

IF  USING  OR  INMODULE  AND  ININTERFACE  THEN  FORW  :=  FALSE 
ELSE 

BEGIN  SEARCHSECTI0N(DISPLAYCT0P3.FNAME»LCP) ; 
IF  LCP  <>  NIL  THEN 
BEGIN 

IF  LCP'^.KLASS  =  PROC  THEN 

FORW  :=  LCP'^.FORWDECL  AND  (FSY  =  PROCSY) 
AND  (LCP^.PFKIND  =  ACTUAL) 
ELSE 

IF  LCP^.KLASS  =  FUNC  THEN 

FORW  :=  LCP-^aFORWDECL  AND  (FSY  =  FUNCSY) 
AND  (LCP'^.PFKIND  =  ACTUAL) 
ELSE  FORW  :r  FALSE? 
IF  NOT  FORW  THEN  ERROR(160) 
END 

else  forw  :=  false 
end; 
if  not  forw  then 

BEGIN 

IF  FSY  =  PROCSY  THEN 

IF  INMODULE  THLN  NEW ( LCP, PROC .DECLARED. ACTUALtTRUE) 
ELSE  NEW (LCP, PROC, DECLARED  I  ACTUAL. FALSE) 
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ELSE 

IF    irjMODULE    THEN    NEW  (  LCP ,  FUNC  1  DECLARED*  ACTUAL .  TRUE  ) 
ELSE    NLii^KLCPtFUNCiDECLAREDtACTUAL, FALSE)  ; 

WITH    LCP"    DO 

3EGIN  NAME  :=  ID;  IDTYPE  :=  NIL;  LOCALLC  :=  LC; 
PFDECKIND  :=  DECLARED;  PFKIND  :=  ACTUAL; 

iNscopE  :=  false;  pflev  :=  level; 

PFNAME  :=  NEXTPROC;  PFSEG  :=  SEG; 

IF  USING  THEN  PROCTABLECNEXTPROC 3  :=  0; 

IF  INMODULE  THEN 

IF  USING  THEN  IMPORTED  :=  TRUE 
ELSE  IMPORTED  :=  FALSE; 
IF  SEGDEC  THEN 
BEGIN 

IF  NEXTSEG  >  MAXSEG  THEN  ERROR(250); 
NEXTSEG  :=  NEXTSEG+i; 
SEGTABLECSEG3,SEGNAME  1=  ID 
END; 
IF  NEXTPROC  =  MAXPROCNUM  THEN  ERR0R(251) 
ELSE  NEXTPROC  :=  NEXTPROC  +  11 
IF  FSY  =  PROCSY  THEN  KLASS  :=  PROC 
ELSE  KLASS  :=  FUNC 
END; 
ENTERID(LCP) 
END 
ELSE 

BEGIN  LCPl  :=  LCP'^.NEXT; 
WHILE  LCPl  0  NIL  00 
BEGIN 

WITH  LCPl**  DO 

IF  IDTYPE  =  NIL  THEN 


EXTONLY  :=  TRUE 
ELSE 

IF  KLASS 
BEGIN 
LCM  :  = 
IF  LC^^ 
END 
ELSE 

IF  KLASS 
BEGIN 


=  FORMALVARS  THEN 

=  VADDR  +  PTRSIZE; 
>  LC  THEN  LC  :=  LCM 


=  ACTUALVARS  THEN 
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LCM  :=  VADDR  +  IDTYPE'^.SIZE; 
IF  LCM  >  LC  THEN  LC  :=  LCM 
END; 
LCPl  :=  LCPl'^.NEXT 
END; 

IF  SEG  0  LCP'^.PFSEG  THEN 

BEGIN 

SEG  :=  LCP'^.PFSEG;  NEXTPROC  :=  2; 
IF  NOT  SEGDEC  THEN  ERR0R(399) 
END 

end; 
insymbol 

END 
ELSE 

BEGIN  ERR0R(2)?  LCP  :=  UPRCPTR  END; 
WITH  LLEXSTK  DO 

BEGIN  dqldlev:=level; 
doldtop:=top; 
poldproc:=curproc; 
dfpr0cp:=lcp; 

end; 

CURPROC  :=  lcp'^.pfname; 

3EGIN  TOP  :=  TOP  +  i; 
WITH  DISPLAYCTOPJ  DO 
BEGIN 

IF  FORW  THEN  FNAME  :=  LCP'", NEXT 
ELSE  FNAME  :=  NIL; 

FLABEL  :=  NIL;  FFILE  :=  NIL;  OCCUR  :=  BLCK 

END 
END 
ELSE  ERROR(250) ; 
IF  FSY  =  PROCSY  THEN 

3EGIN  PARAMETEKLIST(CSEV|IC0L0N3. LCPl, LCP)  ; 

IF  NOT  FORW  THEN  LCP'". NEXT  :=  LCPl 
END 
ELSE 

3EGIN  PARAMETERLIST{CSEN|IC0L0N»C0L0N3, LCPl, LCP)  ; 
IF  NOT  FORW  THEN  LCP'", NEXT  :=  LCPl; 
IF  SY  =  COLON  THEN 
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3EGIIJ    I^JSYMBOLS 

IF  SY  =  IDENT  THEN 

6EGlfvj  IF  FORW  THEN  ERROR  (122); 
SEARCHID (C types:. LCPl ) ; 
LSP  :=  LCPl'^.IDTYPE; 

lcp'.idtype  :=  lsp; 
if  lsp  <>  nil  then 
if  not  (lsp'^.form  in  c  scalar ,  subrange  , pointer d  )  then 
begin  error(120);  lcp'^.idtype  :=  nil  end; 
insymbol 

END 
ELSE  BEGIN  ERR0R(2);  SKIP(FSYS  +  CSEMICOLOND)  END 
END 
ELSE 

if  not  forw  then  err0r(123) 

end; 

IF  SY  =  SEMICOLON  THEN  INSYMBOL  ELSE  ERR0R(14); 
LCp-.EXTURNAL  :=  FALSE; 
IF  (SY  =  EXTERNLSY) 

OR  ((USING)  AND  (LSEPPROO)  THEN 
BEGIN 

IF  LEVEL  <>  2  THEN 

ERR0R{183)  (^EXTERNAL  PROCS  MUST  BE  IN  OUTERMOST  BLOCK*); 
IF  INMODULE  THEN 

IF  ININTERFACE  AND  NOT  USING  THEN 

ERR0R(184);  (*N0  EXTERNAL  DECL  IN  INTERFACE*) 
IF  SEGDEC  THEN  ERR0R{399); 
WITH  LCP''  DO 

BEGIN  EXTURNAL  :=  TRUE;  FORWDECL  :=  FALSE; 

WRITELN(OUTPUT) ;  WRITELN{OUTPUT. NAME. '  C • .MEMAVAIL: 5. '  WORDSDMJ 

wr i te( output. •<'»screend0ts:4»»>m 
end; 
proctableccurproc:  :=  0; 
olinkerinfo  :=  true; 
if  sy  =  externlsy  then 
begin  insymbol; 
if  sy  =  semicolon  then  insymbol  else  err0r(14); 
if  not  (sy  in  fsys)  then 
begin  err0r(6);  skip(fsys)  end 

END 
EtjD 
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ELSE 

IF  USING  THEi-J 

BEGIN  LCP-.FORWOECL  :=  FALSE; 
END 
ELSE 

IF  (SY  =  FORWARDSY)  OR  INMODULE  AND  INJNTERFACE  THEN 
3EGIN 

IF  FORw  THEN  ERR0R(l6l) 
ELSE  LCP^.FORWDECL  :=  TRUE; 
IF  SY  =  FORWARDSY  THEN 
BEGIN  INSYMBOL; 

IF  SY  =  SEMICOLON  THEN  INSYMBOL  ELSE  ERR0R(14) 
END} 
IF  NOT  (SY  IN  FSYS)  THEN 

BEGIN  ERR0R(6);  SKIP<FSYS)  END 
END 
ELSE 
BEGIN 

IF  EXTONLY  THEN 
ERR0R(7); 

newblockistrue; 
notdone:=true; 

WITH  LLEXSTK  do 
BEGIN 

MARKCDMARKP) ; 
WITH  LCP**  DO 

BEGIN  FORWDECL  :=  FALSE;  INSCOPE  :=  TRUEl 
EXTURNAL  :=  FALSE  END; 

bfsy:=semicolon; 

issegment:=se6dec; 

prevlexstackp:=tos; 

END; 
NEW(TOS) J 
T0S'*:=LLEXSTK; 
EXIT(PROCDECLARATION); 

end; 

WITH  LLEXSTK  DO   (*  FORWARD  OR  EXTERNAL  DECLARATION,  SO  RESTORE  STATE  *) 

BEGIN 

level:=doldlev; 
top:=doldtop5 

LC:=DLLC; 
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CURPROC:=POLDPROC; 
IF    SEGDEC    THEN 
BEGUM 

nextpkoc:=soldproc; 
seg:=doldseg; 
end; 

Er'jD; 

END;  (*  PROCDECLARATION  *) 

BEGIN  (*DECLARATI0NPART*) 

IF  (NOSWAP)  AND  (STARTINGUP)  THEN 
BEGIN 

startingup:=false;  (*  all  segments  are  in  by  this  time  ♦) 

3L0CK(FSYS) ; 

exit(declarationpart) ; 

end; 
if  noisy  then 

UNiTWRITE(3«DUMMYVARC-1600],35) ;  (*ADJUST  DISPLAY  OF  STACK  AND  HEAP*) 
REPEAT 

notdone:=false; 

IF  USERINFO. STUPID  THEN 
IF  NOT  CODEINSEG  THEN 

IF  (LEVEL  =  1)  AND  (NEXTSEG  =  10)  THEN 

IF  NOTdNMODULE  OR  USING)  THEN  USESDECLARATION (TRUE ) J 
(*T0  GET  TURTLE  GRAPHICS*) 
IF  SY  =  USESSY  THEN 

3EGIN  INSYMBOL;  USESDECLARATI0N(FALSE )  END; 
IF  sY  =  LABELSY  THEN 
3EGIN 

IF  INMODULE  AND  ININTERFACE  THEN 

BEGIN  ERR0R(186);  SKIP(FSYS  -  ELABELSY])  END 
ELSE  INSYMBOL;  LABELDECLARATION  END; 
IF  sY  =  CONSTSY  THEN 

BEGIN  INSYMBOL?  CONSTDECLARATION  END; 
IF  SY  =  TYPESY  THEN 

3EGIN  INSYMBOL;  TYPEDECLARATION  END; 
IF  sY  =  VARSY  then 

3EGIN  INSYMBOL;  VARDECLARATION  END; 
IF  LEVEL  =  1  THEN  GLEV  :=  TOP; 
IF  sY  IN  CPR0CSY»FUNCSY,PR06SY]  THEN 


196H  12  i:3  64          3EGPJ 

l9o5  12  1:4  84            IF  INMODULE  THEN 

1^66  12  1:5  33              IF  rarJTEKFACE  AND  MOT  USING  THEN  PUBLICPROCS  :=  TRUE; 

1967  12  1:4  99            REPEAT 

1968  12  i:b  99              LSY  :=  SY?  INSYMBOL; 

1969  12  1:5  J5              IF  LSY  =  PKOGSY  THEM 

1970  12  1:6  10                 IF  INMODULE  THEN 

illl  J?  ^'^  '^"^                                              BEGIN  ERR0R(185  (*SEG  DEC  NOT  ALLOWED  IN  UNIT*)); 

■^^Li  ^^  ^'^  20                    PROCDECLARATIONCPROCSY, FALSE) 

i973  12  1:7  22                   END 

1974  12  i:6  24                ELSE  PROCDECLARATION ( LSY .TRUE) 

1975  12  1:5  28              ELSE  PROCDECLARATION ( LSY . FALSE) 5 

1976  12  1:4  36            UNTIL  NOT  (SY  IN  CPROCSY . FUNCSY.PROGSYD) 

1977  12  1:3  48          end; 

1978  12  1:2  51        IF  (SY  <>  BEGINSY)  THEN 

J'oln  ^^  ^'^  ^^         ^^    ^^"^    ((USING  OR  INMODULE)  AND  (SY  IN  C  IMPLESY.ENDSYD)  ) 

1980  12  1:3  75            AND  NOT(  SY  IN  CSEPARATSY,UNITSY3)  THEN 

1981  12  i:h  9if           jp  (^oT  (INCLUDING  OR  NOTOONE)) 

1982  12  1:4  99              OR 

^QQ^  12  1:4  99              NOKSY  IN  BLOCKBEGSYS)  THEN 

^llt  Jo  J:^  li                                 ^^^^^    ERROR(ia);  SKIP(FSYS  -  CUNITSY, INTERSY3) ;  END  J 

,Qo.  Jo  ^'^  ^^              ^^'^^^    <SY  IN  (STATBEGSYS  +  CSEPARATSY.UNITSY,  IMPLESY.ENDSYD)  )  ; 

1986  12  1:1  59      NEWBlOCK:=FALSE; 

1987  12  1:0  62    END  ( *0ECLARATI0NPART*)  ; 

1988  12  i;o  78 

1989  12  1:0  78 

1990  12  1:0  78  (*$I  #5:dECPART.C.TEXT*) 

1990  12  1:0  78  (*$I  «5:3D0YPART.A.TEXT*) 

1991  12  1:0  78 

1992  12  1:0  78  (*     COPYRIGHT  (C)  1979»  REGENTS  OF  THE         *) 

1993  12  1:0  78  <*     UNIVERSITY  OF  CALIFORNIA.  SAN  DIEGO        ♦) 

1994  12  1:0  78 

1995  13  i:d  1  SEGMENT  PROCEDURE  BODYPART ( FSYS:  SETOFSYS;  FPROCP:  CTP); 

1996  13  1:d  6 

1997  13  2:d  1    PROCEDURE  LINKERREF ( KLASS:  IDCLASS;  ID,ADDR:  INTEGER); 

1998  13  2;o  0    BEGIN 

1999  13  2:1  0      IF  NREFS  >  REFSPERBLK  THEN  {*WRITE  BUFFER*) 

2000  13  2:2  9        BEGIN 


2001   13     2:3      9 


2002  13     2:3     36  REFBLK  :=  REFBLK  +  i; 

2003  13     2:3     44  MREFS  :=  1 


IF  BLOCKlA(RITE(REFFILE,REFLIST'^.l, REFBLK)  <>  1  THEN  ERRQR(402); 
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2001 

13 

2:2 

11 

2005 

16 

2:1 

18 

2006 

13 

2:2 

60 

2007 

13 

2:5 

60 

2008 

13 

2:3 

71 

2009 

13 

2:5 

81 

2010 

13 

2:2 

81 

2011 

13 

2:1 

87 

2012 

13 

2:0 

90 

2013 

13 

2:c 

08 

201f 

13 

3;d 

1 

2015 

13 

3:d 

2 

2016 

13 

3:0 

0 

2017 

13 

3:1 

0 

2018 

13 

3:1 

10 

2019 

13 

3:2 

15 

2020 

13 

3:3 

15 

2021 

13 

3:3 

21 

2022 

13 

3:3 

31 

2023 

13 

3:3 

37 

202^ 

13 

3:1 

10 

2025 

13 

3:5 

15 

2026 

13 

3:5 

71 

2027 

13 

3:1 

80 

2028 

13 

312 

83 

2029 

13 

3:0 

83 

2030 

13 

3:0 

98 

2031 

13 

4:d 

1 

2032 

13 

'flO 

0 

2033 

13 

1:1 

0 

2031 

13 

4:1 

10 

2035 

13 

1:2 

15 

2036 

13 

f  :3 

23 

2037 

13 

'+:3 

32 

2038 

13 

4:3 

11 

2039 

13 

1:2 

17 

2010 

13 

1:0 

19 

2011 

13 

1:0 

62 

2012 

13 

5:d 

1 

2013 

13 

5:o 

0 

2011 

13 

5:1 

0 

EIMj; 
WITH    REFLIST'^CNREFSH    DO 

BEGIN 

IF  klass  in  vaks  then  key  :=  ID  +  32 

ELSE  (*PROC#)  KEY  :=  ID; 
OFFSET  :=  SEGINX  +  ADDR 
end; 
NREFS  :=  NREFS  +  1 
END  (*LINKERREF*)  ; 

PROCEDURE  G£N0(FOP:  OPRaNGE); 

VAR  I:  integer;  oddic:  boolean; 

BEGIN 

IF  FOP  0  38(*LCA*)  THEN  GENBYTE(F0P+128) 
ELSE 
BEGIN 

ODOIC  :=  ODD(IC);  STRGCSTIC  :=  ic; 
IF  NOT  ODDIC  THEN  GENBYTE (215( *NOP*) ) ; 
GENBYTE(166(*LCA*)); 
WITH  GATTR.CVAL.VALP'*  DO 
BEGIN  GENBYTECSLGTH) ; 

FOR  I  :=  1  TO  SLGTH  DO  GENBYTE ( ORD(SVALC 1 3) ) ; 
IF  ODDIC  THEN  GENBYTE ( 215 ( *NOP* ) ) 
END 
END 
END  (*GEN0*)  ; 

PROCEDURE  GENLDCdvAL:  INTEGER); 

BEGIN 

IF  (IvAL  >=  0)  AND  (IVAL  <=  127)  THEN  GENBYTE ( IVAL ) 

ELSE 

BE31N  GENBYTE(51(*LDC*)+118) ; 
SENBYTE(  ABS(IVAL)  MOD  256  ); 
GENBYTE(  ABS(IVAL)  DIV  256  ); 
IF  IVAL<0  THEN  GENO ( 17 ( *NGI*) ) 
END 
END  (*GENLDC*)  ; 

PROCEDURE  GENBIGdVAL:  INTEGER); 
BEGIN 

IF  IVAL  <=  127  THEN  GENBYTE ( IVAL ) 


O  •**  '^ 


-^045  13  5:i  &  FLSE 

2046  13  5:2  11  EE3IN 

lall  ^^l  V'l  II  5ENBYTE(  128+(IVAL  DIV  256)  ); 

^nuq  :i  1:1  ^l  GENBYTE(  IVAL  MOD  256  ) 

2050  13  5:0  31  END  (*GENBIG*)  ; 

<:051  13  5:0  41 

2053  ^l  V.n  I  PROCEDURE  GENKFOP;  OPRaNGE;  FP2:  INTEGER) 

tiUDO  13  6:d  3  LABEL  1; 

i^nlt  }l  ^''°  ^  ^AR  I"JJ  INTEGER; 

2055  13  6:0  0  BEGIN 

Iniy  il  f'^  °  GENBYTE(F0P  +  128); 

20ll  II  III  ,1  '\li;,=    ^^<*^°^*'    ^HEN 

2§6'o  II  III  II  l[s7'    '-    '    '"'"    '    '^    ^^'^'''^ 

^?fj  il  ^•'+  23  BEGIN  I  :=  a; 

2062  13  6:5  26 


2063  1^  A.^  ,,  ^"^^^    I    >    0    DO 

2064  ll  lit  II  IF    GATTR.CVAL.VALP-^.CSTVALCn   <>    0    THEN   6OTO    1 

2065  13  6:5  55  1:      end;  I    -    I    "    1' 

lilt  ^l  t:t  ll  GATTR.TYPTR-.SIZE    :=    i; 

<:u&7  13  6.3  58  IF    I    >    1    THEN 

2069  ll  VA  ty  ^^^^^    GENBYTE(I); 

2070  13  I'll  I7  ^/^^^    ^  •=  ^  °°"'^^°  ^  °°  GENW0RD(GATTR.CVAL.VALP-.CSTVALCJ3) 

2071  13  6:3  97  FiSE 

I'll  \l  1:1  99  BEGIN  IC  :=  IC  -  1; 

207^  13  6;^  ll  EN^  ^  "  ^  ^''^''  ^^''L°'=''5^TTR.CVAL.VALP'^.CSTVALC13) 

2075  13  6:2  20  END 

2076  13  6:1  20  ELSE 

207I  ll  V'l  \\  '^^    ^^^    ^^    i:30(*CSP*),32(*ADJ*),'+5(«RNP*), 

2079  13  V'o  o^  '^6(*CIP*),60{*LDM*).61{*STM*), 

2080  13  6'p  X  65(*RBP*).66{*CBP*).78{*CLP*). 

2081  13  6I2  41  ELSE  ^^2  { ♦SAS* )  ,79(  ♦CSP* )  3  THEN  GENBYTE  (FP2) 

POfl^  W  ^i,^  ?t  ^^  INMODULE  AND  (FOP  IN  C37  (  *LAO*)  ,  41  (  *LDO*  )  ,43  (  *SRO*)  1)  THrw 

2084  il  sM  "  ^BpiNLlNKERREF(ACTUALVARS.FP2.K,t^ENBYlEa2;r^^^^         END 


2085   13     6:4     80  ^^fp  ((FOP  = 


74(*LDL*))  OR  (FOP  =  41{*LD0*))) 
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2086 
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68 

2098 
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2099 

13 

7:0 

0 

2100 

13 

7:i 

0 

2101 

13 

7:2 

9 

2102 

13 

7:2 

25 

2103 

13 

7:1 

25 

210^ 

13 

7:2 

27 

2105 

13 

7:2 

28 

2106 

13 

7!3 

*f2 

2107 

13 

7:3 

50 

2108 

13 

7:4 

5f 

2109 

13 

7:5 

60 

2110 

13 

7:4 

66 
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13 

7;2 

68 
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13 

7:3 

70 

2113 

13 

7:if 

70 

211'* 

13 

7:4 

79 
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13 

7:5 

83 
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13 

7:6 

83 
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13 

7:5 

96 

2118 

13 

7:3 

98 

2119 

13 

7:0 

98 

2120 

13 

7:0 

10 

2121 

13 

8:d 

1 
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13 

8:d 

2 

2123 

13 

9:d 

1 

212*+ 

13 

9:0 

0 

2125 

13 

9:1 

0 

2126 

13 

9:1 

9 
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AND  (FP2  <=  16)  THEN 

BEGi'N)  ic   :=  ic-i; 

IF  FOP  =  ^K+LDO*)  THEN  GEN3YTE  ( 231  +  FP2 ) 
ELSE  GENBYTE(215+FP2) 
END 
ELSE 

IF  (FOP  =  35(*IND*))  AND  (FP2  <=  7)  THEN 
BEGIN  IC    :=  iC-i;  GENBYTE(2tf8  +  FP2)  END 
ELSE 

GENBIG(FP2) 
END  (*GEN1*)  ; 

PROCEDURE  GEN2(F0P:  OPRaNGE?  FPlfFP2:  INTEGER); 
BEGIN 

IF  (FOP  =  64(*IXP*))  OR  (FOP  =  77(*CXP*))  THEN 

BEGIN  GENBYTE(F0P+128);  GENBYTE (FPl ) ;  GENBYTE (FP2 ) ; 
END 
ELSE 

IF  FOP  IN  C'+7(*EQU*)»^8(♦GEQ*)  if9(*6RT*)» 

52(*LEQ*)»53{*LES*).55(«NE0*)3  THEN 
IF  FPl  =  0  THEN  GEN0(FOP+20) 
ELSE 

BEGIN  GEN1(F0P,FP1+FP1) ! 

IF  FPl  >  «*  THEN  GEN3IG{FP2) 
END 
ELSE 

BEGIN  (*LDAtLOD.STR*) 

IF  FPl  =  0  THEN  GENl(FOP+20tFP2) 
ELSE 
BEGIN 

GENBYTE(F0P+12a) ;  GENBYTE ( FPl ) !  GENBIG(FP2) 
END 
END; 
END  (*GEN2*)  ; 

PROCEDURE  GENNR(EXTPROC:  NONRESIDENT); 

PROCEDURE  ASSIGN(EXTPR0C:  NONRESIDENT); 
BEGIN 

PROCTABLECNEXTPROCJ  :=  0; 

PFNUVI0FCEXTPR0C3  :=  NEXTPROC;  NEXTPROC  :=  NEXTPROC  +  1; 


2127 

13 

3:i 

24 

2128 

13 

9:i 

38 

S12y 

13 

5:q 

5B 

2130 

13 

sir, 

b4 

2131 

13 

a:  0 

0 

2132 

13 

8:i 

0 

2133 

13 

8:i 

14 

213«+ 

13 

8:2 

18 

2135 

13 

8:3 

18 

2136 

13 

8:2 

34 

2137 

13 

8:1 

36 

2138 

13 

s:2 

38 

2139 

13 

8:0 

43 

21^+0 

13 

8:0 

60 

2im 

13 

io:d 

1 

21»+2 

13 

io:d 

3 

21<+3 

13 

10:0 

0 

21ftf 

13 

10:1 

0 

2145 

13 

10:2 

3 

21f6 

13 

10:3 

7 

2117 

13 

10:4 

7 

2i'+a 

13 

lo:^ 

15 

2119 

13 

10:4 

23 

2150 

13 

10:4 

33 

2151 

13 

10:5 

38 

2152 

13 

10:6 

38 

2153 

13 

10:7 

44 

215«+ 

13 

10:8 

51 

2155 

13 

10:8 

61 

2156 

13 

10:8 

74 

2157 

13 

10:7 

81 

2158 

13 

10:6 

84 

2159 

13 

10:6 

89 

2160 

13 

10:5 

98 

2161 

13 

1013 

01 

2162 

13 

10:2 

01 

2163 

13 

10:3 

03 

216'+ 

13 

10:4 

12 

2165 

13 

io:h 

18 

2166 

13 

10:4 

29 

2167 

13 

10:3 

35 

J[i'kERINFO  L'^J^:;«^^^^^  T'^^'^  ERR0R(193,;(*N0T  ENOUGH  ROOM  FOR  THIS*) 
^m     {*ASSI3N*)*;  ^OPERATION*) 

BEGIN  (*GENI\JH*) 

IF  PFNUMOFCEXTPROCH  =  0  THEN  ASSIGN (EXTPROC ) ; 
IF  SlPPROC  then 
BEGIN 

^^GEN1(79(*CGP*),0);  LINKERREF ( PROc , -PFNUMOFC EXTPROC 3, IC-1 ) 

ELSE 

GEni(79(*CGP*) ,PFNUM0FCEXTPR0CD) ; 
END  (♦GENNR*)  ; 

PROCEDURE  GENJMP(F0P:  OPRANgE;  FLBP:  LBPJ! 

var  disp:  integer; 

BEGIN 

WITH  FLBP'"  DO 

IF  DEFINED  THEN 
BEGIN 

eENBYTE(FOP+128) ; 

DISP  :=  OCCURIC-lC-1! 

IF^^DISP  >=  0)  AND  (DISP  <=  127)  THEN  GENBYTE (DISP ) 

BEGIN 

IF  JTABINX  =  0  THEN 

BEGIN  JTABINX  :=  NEXTJTAB; 

IF  NEXTJTAB  =  MAXJTAB  THEN  ERR0R(253) 
ELSE  NEXTJTAB  :=  NEXTJTAB  +  15 
JTABCJTABINX3  :=  OCCURIC 
END; 

DISP  :=  -JTABINX; 

GENBYTE (248- JTABINX- JTABINX) 

end; 

END 
ELSE 

BEGIN  M0VEL£FT(REFLIST.C0DEP'*CIC1,2)  ; 

IF  FOP  =  57{*UJP*)  THEN  DISP  :=  IC  +  4096 

ELSE  DISP  :=  IC; 

REFLIST  :=  DISP;  IC  :=  ic+2 

end; 
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13 
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13 
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13 
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0 
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2 

2175 

13 
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If 

2176 

13 
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16 

2177 

13 
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30 

2178 

13 

13:q 

1 

2179 

13 

13:0 

0 

2180 

13 

13:1 

f 

2181 

13 

13:2 

a 

2182 

13 

13:0 

18 

2183 

13 

i3:o 

30 

218^ 

13 

l^ftD 

1 

2185 

13 

i«+:d 

2 

2186 

13 

If  :o 

0 

2187 

13 

i**:i 

0 

2188 

13 

i'+:2 

3 

2189 

13 

I'+rs 

7 

2190 

13 

14:3 

20 

2191 

13 

If  :4 

27 

2192 

13 

14:5 

27 

2193 

13 

m:6 

3f 

2194 

13 

11:5 

ff 

2195 

13 

m:5 

f9 

2196 

13 

11:5 

52 

2197 

13 

If  :5 

60 

2198 

13 

If  :f 

62 

2199 

13 

If  :3 

66 

2200 

13 

If  :2 

66 

2201 

13 

If  :o 

70 

2202 

13 

If  :o 

8f 

2203 

13 

ii:d 

1 

220f 

13 

11  ;c 

1 

2205 

13 

11:0 

0 

2206 

13 

11:1 

0 

2207 

13 

11:2 

0 

2208 

13 

11:3 

5 

END  (*GEWJMP*)  ; 

PROCEDURE  LOAD;  FORw'ARD; 

PROCEOUkE  GENFjPiFLBP:  LBP); 
BEGIN  LOAD; 

IF  GfiTTR.TYPTR  <>  BOOLPTR  THEN  ERR0R{135); 

GENJviP(33(*FJP*)  ,FLBP) 
END  (♦GENFJP*)  ; 

PROCEDURE  GENLABEL(VAR  FLOP:  LBP); 
BEGIN  NEW(FLBP) ; 
WITH  FLBP'^  DO 

BEGIN  DEFINED  :=  FALSE;  REFLIST  :=  MAXADDR  END 
END  (*GENLA8EL*)  ; 

PROCEDURE  PUTLABEL(FLBP:  LBP); 

VAR  lref:  integer;  lop:  oprange; 

BEGIN 

WITH  fLBP^  do 

BEGIN  LREF  :=  REFLIST; 

DEFINED  :=  TRUE;  OCCURIC  :=  IC;  JTABINX  :=  0; 
WHILE  LREF  <  MAXADDR  DO 
BEGIN 

IF  LREF  >=  f096  THEN 

BEGIN  LREF  :=  LREF  -  f096;  LOP  :=  57<*UJP*)  END 
ELSE  LOp  :=  33(*FJP*) ; 

IC  :=  lref; 

MOVELEFT(CODEP^i:lC3tLREF»2)  ; 
GENJMP(LOP»FLBP) 

end; 
ic  :=  occuric 

END 
END  {*PUTLABEL*)  ; 

PROCEDURE  LOAD; 

VAR  jim:  integer; 

BEGIN 

WITH  GATTR  DO 

IF  TYPTR  <>  NIL  THEN 

BEGIN 
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casl  kind  of 

cst:    if  TYPTR'^.FORM  =  longint  iHErg 
WITH  GATTR.CVAL.VALP'^  DO 
BEGIM 

M  :=  10000; 

6ENLDC(L0NGVALC1D);  GENLDC ( 18( *DCVT* ) ) J  GENNR (DECOPS ) 
FOR  J  :=  2  TO  LLENG  DO 
BEGIN 

IF  J  =  LLENG  THEN  M  :=  TRUNC (PWROFTEN(LLAST) ) ; 
GEMLDC(M);  GENLDC(18(*DCVT*));  GENNR{DECOPS) ; 
GEMLDC{8(*DMP*)) ;  GENNR ( DECOPS) ; 
GENLDCCLONGVALCJJ) ; 
GENLDC(18{*DCVT*));  GENNR (DECOPS) { 
GENL0C(2{*DAD*));  GENNR (DECOPS) 
END 


AND  (TYPTR  <>  REALPTR)  THEN 


varbl: 


END 
ELSE 

IF  (TYPTR'*, FORM  =  SCALAR) 

GENLDC(CVAL.IVAL) 
ELSE 

IF  TYPTR  =  NILPTR  THEN  GEnO (31 ( ♦LDCN* ) ) 
ELSE 

IF  TYPTR  =  REALPTR  THEN  GENl (51 {*LDC*) f 2 ) 
ELSE  GENl(51(*LDC*)f5)5 
CASE  ACCESS  OF 


expr: 

END; 

WITH 

IF 


drct: 

indrct: 
packd: 

MULTi: 
BYTE: 

end; 


IF  VLEVEL  =  1  THEN  GENl (11 (♦LDO*) .DPLMT ) 
ELSE  GEN2(5l(*L0D*)fLEVEL-VLEVEL, DPLMT); 
GEN1(35(*IND*) tIDPLMT) ; 
GEN0(58(*LDP*) ) ; 

GENl  ( 60  (♦LDM*)f  TYPTR-". SIZE)  ; 
GE.N0(62(*LD3*)  ) 


END 


KIND 
END 
(♦LOAD*) 


typtr*^  do 

( (form  =  power)  or 

(form  =  longint)  and  (kind  <>  cst)) 

AND  (KIND  0  EXPR)  THEN  GENLDC ( TYPTR^.SIZE) ; 
:=  EXPR 
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3C3 

2250  13  li:o  38 

2251  13  15:d    1   PROCEDURE  store(var  fattr:  ATTR); 

2252  13  15:o      0    BEGIN 

2253  13  15:i      0      wlITH  fATTR  DO 

2254  13  1512      3        IF  TYPTR  O  NIL  THEN 

2255  13  15:3      9  CASE  ACCESS  OF 

2256  13  1513  13  DRCT:    IF  VLEVEL  =  1  THEN  GENl ( 43< *SRO*) ,DPLMT ) 

2257  13  15:t+  22  ELSE  GEN2  ( 56  ( *STR* )  .  LEVEL-VLEVEL  .DPLMT )  ; 

2258  13  15:3  38  INDRCT:  IF  IDPLMT  <>  0  THEN  ERROR(400) 

2259  13  15:4  47  ELSE  GENO ( 26 ( *STO*) ) ; 

2260  13  15:3  57  PACKD:   GENO ( 59 ( *STP* ) ) ; 

22S1  13  15:3  62  MULTi:   GENl  <  61  ( *STM*)  ,  TYPTR'^.SIZE )  ; 

2262  13  15:3  70  BYTE:    GEnO C 63 ( *ST3* ) ) 

2263  13  15:3  71  END 

2264  13  15:q  92    END  {*ST0RE*)  ; 

2265  13  15:0  04 

2266  13  16:D      1    PROCEDURE  LOADADDRESSj 

2267  13  16:o      0    BEGIN 

2268  13  16:i      0      WITH  GATTR  DO 

2269  13  16:2      0        IF  TYPTR  <>  NIL  THEN 

2270  13  16:3      5  3EGIN 

2271  13  16:4      5  CASE  KIND  OF 

2272  13  16:4      8  CST:    IF  STRGTYPE( TYPTR )  THEN  GENO ( 38 (*LCA* ) ) 

2273  13  16:5  17  ELSE  ERROR{400); 

2274  13  16:4  29  VARBL:  CASE  ACCESS  OF 

2275  13  16:5  32  DRCT:    IF  VLEVEL  =  1  THEN  GENK 37(*LA0* ) tOPLMT) 

2276  13  16:6  39  ELSE  GEN2 ( 50 ( ♦LDA* ) i LEVEL-VLEVELtDPLMT ) } 

2277  13  16:5  53  INDRCT:  IF  IDPLMT  <>  0  THEN  GENl (34 ( *INC* ) i IDPLMT) ; 

2278  13  16:5  64  PACKD:   ERROR(103) 

2279  13  16:5  65  END 

2280  13  16:4  84  END; 

2281  13  16:4  98  KIND  :=  VARBL;  ACCESS  :=  INDRCT;  IDPLMT  :=  0 

2282  13  16:3  04  END 

2283  13  16:0  07    END  ( *L0ADADDRESS* )  ; 

2284  13  16:0  20 

2285  13  17:D  1    PROCEDURE  BYTEADDReSS; 

2286  13  17:o  0    BEGIN 

2287  13  17:i  0      WITH  GATTR  DO 

2288  13  17:2  0        IF  TYPTR  <>  NIL  THEN 

2289  13  17:3  5  3EGIN 

2290  13  17:4  5  CASE  KINO  qF 


P292  A  w"  J              ^^^*    ^^  STRGTYPL(TYPTR)  THEN  GENO { 38 ( *LCA* ) ) 

o?g?  ^i  ,i:?  II                                                        ^L5^  ERROR(400); 

"294  13  17's  -p              VAR3L:  CASL  ACCESS  QF 

2295  13  17*6  39  '^^^^ '  ^^    ^LZ^JZL    =  1  THEN  GENl  ( 37  { *LAO* )  ,  DPLMT ) 

2296  13  17'^  ii  ^^^^    GEN2(50{*LDA*),LEVEL-VLEVEL,DPLMT)5 

2297  13  17-5  H  l^.^^^^ '     ^^    ^^^^'^"^  <>  °  ^^^^    GENK  3«+ ( *INC* )  ,  IDPLMT )  ; 

pp9ft  ii  1-7.'^  ^^                packd:  er^or(103) 

2298  13  17:5  65  pr,n 

2299  13  17:^  8'+  emq; 

23cS  ^3  1711;  09            e[sE^^^°  ^^    '^'^^^^    ^^^^    '^"^^  ^^^^    *=  ^'^^^'-'  ^ENLDC  ( 0 )  END 

23S3  13  IV'l  U              IF  ACCESS  O  BYTE  THEN  GENLDC(O); 

230-+  13  17:3  22          END       '" 

?^2?  U  P*°  2^    ^^D  (*3YTEADDRESS*)  ; 

2306  13  17:o  3*+ 


2307   13    18:D      1 


PROCEDURE  STRGTOPA(FIC:  ADDRRANGE)! 


2308  13  ia:o      0      BEGIN 

5^°n  J!  Joi^      °        ^^    ODD(FIC)  THEN 

2310  13  18:2      3         BEGIN 

2312  II  IV'l  on                             MOVERIGHT(  CODEp-CFlC  +  13,  CODEP-CFIC+23.  0RD(C0DEP-CFIC  +  13)+1  )j 

2313  13  is'll  33          r.D      '"''  ''^    CHR(215(*N0P»)),  CODEP-CFIC  +  1 D  i=  CHR  (258  ( 'lpJ*  !  ! 
231^+  13  18:i  34        ELSE 

2315  13  18:2  36          BEGIN 

2317  II  IVA  It                             MOVELEFTC  CODEP-CFIC+23,  CODEP-EFlC+13,  ORD(CODEP-CFlC+23)+l  ); 

2318  II  ll\l  II                        END      '"''  '"    '''^^°^>'  C0DEP^CFIC.0RD(C0DEP'^CFIC.1D).2D  :=  CHR(215, 

2319  13  18:o  73      END  {*STRGTOPA*)  ; 

2320  13  18:o  86 

2321  13  19:o      1 

2322  13  19:d      5 

2323  13  20:d      1 

2325  II  20°;0      0    BEgJn  '''''*  '"'^'^''''^-''^    UMIN.LMAXJ  InTEGER; 

Illy  ii  Inl^               °      ^^"T"  F^P"»  SATTR  DO 

23Pfl  ,1  In''-  ,n        ^^'^^'^  ^^^^^  •=  I'^TYPE;  KIND  :=  VARBL; 

2528  13  20.5  10          CASE  KLASS  OF 

.lln  ^l  1°'^  ^^                              ACTUALVARS: 

233?  II  ll\l  II                                  ''^riKuL^^^HEr'  '''''    ''-    ''''"^    ''''''    '-'-    ^«^^' 


PROCEDURE  EXPRESSI0N(FSYS:  SETOFSYS);  FORWARD; 
PROCEDURE  SELECTOR(FSYS:  SETOFSYS;  FCP:  CTP) ; 
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13 

20:6 

46 
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if  typ7r  <>  nil  then 
if  (vlev  =  1)  and  ( typtr'' .form  =  records)  then  loadaddress 

end; 
fokmalvars: 

BEGIN 

IF  VLEV  =  1  THEN  GENl { 41 ( *LDO* ) ♦ VADDR ) 
ELSE  5EN2(54{*L0D*) ,LEVEL-VLEV»VADDR) ; 

ACCESS  :=  indrct;  ioplmt  :=  o 
END ; 

field: 
with  displaycdisx:  do 
begin 
if  occur  =  crec  then 
begin  access  :=  drct;  vlevel  :=  clev; 
dplmt  :=  cdspl  +  fldaddr 

END 
ELSE 
BEGIN 

IF  LEVEL  =  1  THEN  GENl ( 41 ( *LDO* ) f VDSPL ) 
ELSE  GEN2(54{*L0D*)»0, VDSPL) ; 

ACCESS  :=  indrct;  idplmt  :=  fldaddr 

END; 

if  fispackd  then 
begin  loadaddress; 
access  :=  packo; 

GENLDC(FLDWIDTH) ;  GENLDCCFLDRBIT) 

END 

end; 

FUNC: 

IF  PFDECKIMD  0  DECLARED  THEN  ERRORdSO) 
ELSE 

IF  NOT  INSCOPE  THEN  ERROR(103) 
ELSE 

BEGIN  ACCESS  :=  DRCT;  VLEVEL  :=  PFLEV  +  1; 
DPLMT  :=  LCAFTERMARKSTACK 

ENC 
END  (*CASE*); 
IF  TYPTR  <>  NIL  THEN 

IF  (TYPTR'^.FORM  <=  POi/JER)  AND 
(TYPTR*, SIZE  >  PTRSIZE)  THEN 
BEGIN  LOADADDRESS;  ACCESS  :=  MULTI  END 
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EN J  {*WITH*); 
IF  NOT  (SY  1'4    SElECTSYS  +  FSYS)  THEN 

BEGIN  ERR0R(59):  SKIP ( SELECTSYS  +  FSYS)  END? 
WHILE  SY  IN  SELECTSYS  DO 
BEGIN 
(*C*)  IF  SY  =  LBRACK  THEN 
BEGIN 

REPEAT  LATTR  :=  GATTR; 
WITH  LATTR  DO 

IF  TYPTR  <>  NIL  THEN 

IF  TYPTR^.FORM  <>  ARRAYS  THEN 

BEGIN  ERR0R(138);  TYPTR  Is  NIL  END; 
LOADADDRESS; 

insymbol;  EXPRESSI0N(FSYS  +  CC0MMA,RBRACKD) ; 
LOAD; 
IF  GATTR. TYPTR  <>  NIL  THEN 

IF  GATTR, TYPTR-*. FORM  <>  SCALAR  THEN  ERR0R(113); 
IF  LATTR. TYPTR  <>  NIL  THEN 
WITH  LATTR. TYPTR^  DO 
BEGIN 

IF  COMPTYPESdNXTYPE, GATTR. TYPTR)  THEN 
BEGIN 

IF  (INXTYPE  <>  NIL)  AND 

NOT  STRGTYPE(LATTR. TYPTR)  THEN 
BEGIN  GETBOUNDSdNXTYPEtLMINtLMAX)  ; 
IF  RANGECHECK  THEN 

BEGIN  GENLDC{LMIN);  GENLDC (LMAX) ; 

GEN0(8(*CHK*)) 
END; 
IF  LMIN  <>  0  THEN 

BEGIN  GENLDC(ABS(LMIN)); 

IF  LMIN  >  0  THEN  GENO (21 (*SBI* ) ) 
ELSE  GEN0(2{*ADI*)) 
END 
END 
END 
ELSE  ERR0R(139) ; 
WITH  GATTR  DO 

BEGIN  TYPTR  :=  AELTYPE;  KIND  :=  VARBL; 
ACCESS  :=  INDRCT;  IDPLMT  :=  0; 
IF  TYPTR  0  NIL  THEN 
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IF  AISPACKO  THEW 

IF    ELiflJiOTH    =    8    THEN 

BEGIN  ACCESS  :=  BYTE; 

IF  strgtypeclattr.typtR)  and  rangecheck 

GEN0(27(*IXS*) ) 
ELSE  (*LEA\/E  BASE-INDEX  PAIR*) 
END 
ELSE 

BEGIN  ACCESS  :=  PACKD; 

GEN2(64(*IXP*)«ELSPERWDiELWIDTH) 
END 
ELSE 

BEGIN  GEN1(36(*IXA*)»TYPTR''.SIZE)  ; 
IF  (TYPTR'^.FORM  <=  POWER)  AND 

(Typtr'^.size  >  ptrsize)  then 
ACCESS  :=  multi 

END 
END 

END 
UNTIL  SY  <>  COMMA; 

IF  SY  =  RBRACK  then  INSYMBOL  ELSE  ERR0R(12) 
END  {*IF  SY  =  LBRACK*) 
ELSE 
(*.*)    IF  SY  =  PERIOD  THEN 
BEGIN 

WITH  GaTTR  DO 
BEGIN 

IF  typtr  o  nil  then 
if  typtr*", form  <>  records  then 
begin  error(140);  typtr  :=  nil  end; 
insymbol; 
if  sy  =  ident  then 

BEGIN 

IF  TYPTR  <>  NIL  THEN 

BEGIN  SEARCHSECTlON{TYPTR''.FSTFLD,LCP)  ; 
IF  LCP  =  NIL  THEN 

BEGIN  ERR0R(152)}  TYPTR  :=  NIL  END 
ELSE 

WITH  LCP**  DO 

BEGIN  TYPTR  :=  IDTYPE; 
CASE  ACCESS  OF 


THEN 
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drct:   oplmt  :=  dplmt  +  fldaddr; 

IMDRCT:  IDPLMT  :=  IDPLMT  +  FLDADDR; 
WULTI,3YTE, 

packd:  error{400) 
end  (*case  access*) ; 
if  fispackd  then 

BEGIN  LOADADDRESS; 

ACCESS  :=  PACKD; 

GENLDC(FLDWIDTH) 

END; 

IF  TYPTR  <>  NIL  THEN 

IF  (TYpTR'^.FORM  <=  POWER)  AND 
(TYPTR'*. SIZE  >  PTRSIZE)  THEN 
BEGIN  LOADADDRESS;  ACCESS  :=  MULTI  END 


GENLDC(FLDRBIT) 


END 
END; 
INSYMBOL 
END  (*SY  =  IDENT*) 
ELSE  ERR0R(2) 
END  (*WITH  GATTR*) 
END  (*IF  SY  =  PERIOD*) 
ELSE 
(*'"*)      BEGIN 

IF  GATTR. TYPTR  <>  NIL  THEN 
WITH  GATTR.TYPTR'*  DO 

IF  (FORM  =  POINTER)  OR  (FORM  =  FILES)  THEN 
BEGIN  load;  KIND  .*=  VARBL; 

ACCESS  :=  indrct;  idplmt  :=  0; 

IF  FORM  =  pointer  THEN  TYPTR  :=  ELTYPE 
ELSE 

BEGIN  TYPTR  :=  FILTYPE; 

IF  TYPTR  =  NIL  THEN  ERR0R(399) 
END; 
IF  TYPTR  <>  NIL  THEN 

IF  (TYPTR^.FORM  <=  POWER)  AND 
(TYPTR'^.SIZE 

ACCESS 
END 

ELSE  ERR0R(141) ; 
INSYMBOL 

end; 


>  PTRSIZE) 
:=  MULTI 


THEN 
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2496  13  20:3  03  IF  NOT  (SY  IN  FSYS  +  SELECTSYS)  THEN 

2497  13  20:4  19  BEGIN  ERR0R(6);  SKIP(FSYS  +  SELECTSYS)  END 

2498  13  20:2  39  END  (*WHILE*) 

2499  13  20:0  39    END  (*SELECTOR*)  ; 

2500  13  20:0  72 

2501  13  20:0  72  (*$I  tt5:30DYPART.A,TEXT*) 

2501  13  20:0  72  (*$I  #5:B0DYPART.B.TEXT*) 

2502  13  20:0  72 

2503  13  20:0  72  (♦     COPYRIGHT  (C)  l979i  REGENTS  OF  THE  *) 

2504  13  20:0  72  (*     UNIVERSITY  OF  CALIFORNIA*  SAN  DIEGO  *) 

2505  13  20:0  72 

2506  13  21:d  1    PROCEDURE  CALL(FSYS:  SETOFSYS;  FCPt  CTP); 

2507  13  21:D  6  VAR  LKEY:  1.,43;  WASLPARENT:  BOOLEAN; 

2508  13  21:d  8 

2509  13  22:d  1  PROCEDURE  VARIABLE (FSYS:  SETOFSYS); 

2510  13  22:D  5  VAR  LCP:  CTP; 

2511  13  22:0  0  BEGIN 

2512  13  22:1  0  IF  sY  =  IDENT  THEN 

2513  13  22:2  5  BEGIN  SEARCHXD(VARS+CFIELD3iLCP) J  INSYMBOLEND 

2514  13  22:1  21  ELSE  BEGIN  ERRoR(2);  LCP  :=  UVARPTR  END; 

2515  13  22:1  31  SELECTOR(FSYS.LCP) 

2516  13  22:0  39  END  (*VARIABLE*)  ; 

2517  13  22:0  54 

2518  13  23:d  1  PROCEDURE  STRGVAR (FSYS:  SETOFSYS;  MUSTBEVAR:  BOOLEAN); 

2519  13  23:o  0  BEGIN  EXPRESSION (FSYS) ; 

2520  13  23:1  9  WITH  GATTR  DO 

2521  13  23:2  9  IF  {(KIND  =  CST)  AND  (TYPTR  =  CHARPTR)) 

2522  13  23:2  17  OR  STRGTYPE^  ( TYPTR )  THEN 

2523  13  23:3  26  IF  KIND  =  VARBL  THEN  LOADADDRESS 

2524  13  23:3  31  ELSE 

2525  13  23:4  35  BEGIN 

2526  13  23:5  35  IF  MUSTBEVAR  THEN  ERR0R{154); 

2527  13  23:5  44  IF  KIND  =  CST  THEN 

2528  13  23:6  49  BEGIN 

2529  13  23:7  49  IF  TYPTR  =  CHARPTR  THEN 

2530  13  23:8  55  BEGIN 

2531  13  23:9  55  WITH  SCONST'^  DO 

2532  13  23:0  59  BEGIN  CCLASS  :=  STRG!  SLGTH  :=  1; 

2533  13  23:1  67  SVALCIJ  :=  CHR { CVAL. IVAL) 

2534  13  23:0  74  END; 

2535  13  23:9  75  CVAL.VALP  :=  SCONST; 


2536 

2537 

2538 

2539 

2540 

2541 

2542 

2543 

2544 

2545 

2546 

2547 

2548 

2549 

2550 

2551 

2552 

2553 

2554 

2555 

2556 

2557 

2558 

2559 

2560 

2561 

2562 

2563 

2564 

2565 

2566 

2567 

2568 

2569 

2570 

2571 

2572 

2573 

2574 

2575 

2576 


13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 


23:9 
23:9 
23:9 
23:8 
23:7 
23:6 
23:4 
23:2 
23:3 
23:4 
23:4 
23:3 

23:o 
23:o 

24:o 

24:d 
25:d 
25  :d 
25  :d 
25:d 
25:o 
25:i 

25:i 
25:2 
25:3 
25:4 
25:5 
25:6 
25:7 
25:8 
25:7 
25:4 
25:3 

25:i 

25:2 
25:3 
25:3 
25:3 
25:3 
25:4 
25:4 


79 
84 
S9 
92 
94 
94 
96 
96 
98 
98 
07 
07 
11 
24 
1 
2 
1 
1 
1 
6 
0 
15 
24 
29 
32 
38 
38 
44 
48 
52 
58 
62 
62 
66 
73 
76 
94 
99 
07 
12 
21 


NEW(TYPTR, ARRAYS, TRUE, TRUE) ; 
TYPTR'^  :=  STRGPTR'^; 

TYPTR'^.N^AXLENG  :=  1 
ENU; 

LOADADDRESS 
END 
END 
ELSE 
BEGIN 

IF  GATTR.TYPTR  <>  NIL  THEN  ERR0R(125); 
GATTR.TYPTR  :=  STRGPTR 
END 
END  (*STRGVAR*)  j 

PROCEDURE  R0UTINE(LKEY:  INTEGER); 

PROCEDURE  NEWSTMTl 
LABEL  l; 
VAR  LSP,LSPl;  STP;  VARTS,LMIN,LMAX:  INTEGER; 

lsizeiLsz:  addrrange;  lval;  valu; 

BEGIN  VARIABLE(FSYS  +  CCOMMAfRPARENTD) J  LOaDADDRESS; 

LSP  :=  nil;  varts  :=  o;  lsize  :=  o; 

IF  GATTR.TYPTR  <>  NIL  THEN 
WITH  GATTR.TYPTR'*  DO 
IF  FORM  =  POINTER  THEN 
BEGIN 

IF  ELTYPE  <>  NIL  THEN 
WITH  ELTYPE'^  DO 

BEGIN  LSIZE  :=  SIZE; 

IF  FORM  =  RECORDS  THEN  LSP  :=  RECVAR 

END 
ELSE  ERR0R(116) J 
WHILE  SY  =  COMMA  DO 
BEGIN  INSYMBOL; 

CONSTANT(FSYS  +  CCOMMA, RPARENTDtLSPl ,LVAL) ; 

VARTS  :=  VARTS  +  i; 

IF  LSP  =  NIL  THEN  ERR0R(158) 

ELSE 

IF  LSP-.FORM  <>  TAGFLD  THEN  ERR0R(162) 
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2577 

13 

2b:5 

26 

2578 

13 

25:6 

32 

2579 

13 

25:6 

48 

2530 

13 

25:7 

53 

2581 

13 

25:3 

64 

2582 

13 

25:9 

61 

2583 

13 

25:9 

68 

2581 

13 

25:o 

73 

2585 

13 

25:i 

76 

2586 

13 

25:2 

82 

2587 

13 

25:3 

90 

2588 

13 

25:2 

92 

2589 

13 

25:i 

92 

2590 

13 

25:9 

00 

2591 

13 

25:8 

07 

2592 

13 

25:7 

07 

2593 

13 

25:3 

13 

2591 

13 

25:i 

15 

2595 

13 

25:i 

18 

2596 

13 

25:o 

20 

2597 

13 

25:o 

10 

2598 

13 

26:d 

1 

2599 

13 

26  :o 

0 

2600 

13 

26:i 

15 

2601 

13 

26:i 

29 

2602 

13 

26:2 

36 

2603 

13 

26:i 

51 

2601 

13 

26:2 

53 

2605 

13 

26:i 

68 

2606 

13 

26:i 

82 

2607 

13 

26  :i 

97 

2608 

13 

26:i 

06 

2609 

13 

26:2 

10 

2610 

13 

26:2 

19 

2611 

13 

26:o 

25 

2612 

13 

26:o 

10 

2613 

13 

27:o 

1 

2611 

13 

27:d 

1 

2615 

13 

27:o 

0 

2616 

13 

27:i 

0 

2617 

13 

27:2 

5 

IF  LSP'.TAGFIELDP  <>  NIL  THEN 

IF  STR6TYPE(LSP1)  OR  (LSPl  =  REALPTR)  THEN  ERR0R(159) 

else: 

IF  C0MPTYPES(LSP".TAGFIELDP".IDTYPE,LSP1)  THEN 
BEGIN 

LSPl  :=  LSP'^.FSTVARJ 
WHILE  LSPl  <>  NIL  DO 
WITH  LSPl**  DO 

IF  V/ARVAL.IVAL  =  LVAL.IVAL  THEN 

BEGIN  LSIZE  :=  SIZE!  LSP  :=  SUBVAR; 

GOTO  1 
END 

ELSE  LSPl  :=  nxtvar; 
LSIZE  :=  LSP''. size;  lsp  :=  nil; 

END 
ELSE  ERR0R(116) ; 
i:   END  {*WHILE*>  ; 

genldc(lsize) ; 
gen1(30(*csp*) »1(*new*)  ) 
end  (*newstmt*)  j 

procedure  move} 

BEGIN  VARIABLE(FSYS  +  CC0HHA3) ;  BYTEADDRESS; 
IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 
IF  LKEY  =  27  THEN 

BEGIN  EXPRESSION(FSYS  +  CC0MMA3) ;  LOAD  END 

ELSE 

BEGIN  VARIABLE(FSYS  +  CC0MMA3)}  BYTEADDRESS  ENDI 
IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 
EXPRESSI0N(FSYS  +  CRPARENT^);  LOAD; 
IF  LKEY  =  27  THEN  GENK 30 ( *CSP* ) ♦ 10 { *FLC*) ) 

ELSE 

IF  LKEY  =  21  THEN  GENl { 30 ( *CSP* ) . 2 ( *MVL* ) ) 
ELSE  GENl{30t*CSP*) f 3{*MVR*) ) 
END  (*MOVE*)  ; 

PROCEDURE  EXIT! 

vaR  lcp:  CTP; 

BEGIN 

IF  SY  =  IDENT  then 

BEGIN  SEARcHlD{CPR0CfFUNC3,LCP);  INSYMBOL  END 
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27 

27 

27 

27 

27 

27 

27:3 

27:4 

27:5 

27:6 

27:5 

27:3 

27:2 

27:1 

27:1 

27:0 

27:0 

28:d 
28:o 
28:i 
2a:i 
28:i 
28:i 
26  :i 
28:i 


28:i 
28:2 
28:3 

28:3 

26:4 

28:5 
28:5 
28:4 
28:2 

28:i 
28:i 
28:2 
2a:  3 

28:3 
28:2 
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17 
19 
24 
31 
36 
41 
48 
58 
62 
71 
85 
85 
85 
88 
97 
99 
IH 
1 
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38 
52 
67 
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23 
28 
31 
46 
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55 


ELSE 

IF  (SY  =  PROGSY)  THEN 

BEGIN  LCP  :=  OUTERBLOCK;  INSYMBOL  END 
ELSE  LCP  :=  NIL; 
IF  LCP  <>  NIL  THEN 

IF  LCP'^.PFDECKIND  =  DECLARED  THEN 

BEGIN  GENLDC(LCP'^.PFSEG)  ;  GENLDC  (  LCP^.PFNAME  )  ; 

IF  inmodule  then 

BEGIN  LINKERREF(PR0C.LCP«,PFSEG,IC-2) ; 

IF  SEPPROC  THEN  LINKERREF  (PROC, -LCP'^.PFNAME.  IC-1 )  ; 
END 
END 
ELSE  ERR0R(125) 
ELSE  ERR0R(125)! 
GEN1(30{*CSP*) f4(*XIT*)  ) 
END  (*EXIT*)  ; 

PROCEDURE  UNITIO; 
BEGIN 

IF  GATTR.TYPTR  <>  INTPTR  THEN  ERR0R(125); 
IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20)5 
\/ARIABLE(FSYS  +  CC0MMA3)  5  BYTEADDRESS? 
IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 
EXPRESSION(FSYS  +  CCOMMA, RPARENTD) J  LOAD? 
IF  GATTR.TYPTR  <>  INTPTR  THEN  ERR0R(125)i 
IF  SY  =  COMMA  THEN 
BEGIN  INSYMBOL; 

IF  SY  =  COMMA  THEN  GENLDC(O) 
ELSE 
BEGIN 

EXPRESSION(FSYS  +  CC0MMA,RPARENT3) ;  LOAD; 
IF  GATTR.TYPTR  <>  INTPTR  THEN  ERR0R(125) 
END 
END 
ELSE  GENLDC(0)5 
IF  SY  =  COMMA  THEN 
BEGIN  INSYMBOL; 

EXPRESSIONCFSYS  + 
IF  GATTR.TYPTR  <> 
END 
ELSE  GENLDC(O) ; 


CRPARENT3) ; 
INTPTR  THEN 


load; 

ERR0R(125) 
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29:2 

68 

2675 

13 

29:2 

73 

2676 

13 

29:2 

78 

2677 

13 

29:2 

83 

2678 

13 

29  :i 

87 

2679 

13 

29:i 

93 

2680 

13 

29:2 

00 

2681 

13 
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28 

IF  LKEY  =  13  THEN  GENl ( 30 ( *CSP* ) . 5 ( ♦URO* ) ) 
ELSE  GEN1(30(*CSP») ,6(*UWT*) ) 
END  (*UNITIO*); 


TEMPLGTH:  INTEGER: 


PROCEDURE  CONCAT; 

var  LLC:  aodprange; 

BEGIN  TEMPLGTH  :=  0; 

LLC  :=  Lc;  Lc  :=  LC  +  (STRGlgth  div  chrsperwd)  +  i; 

GENLOC{0) ;  GEN2{56(*STR*)iO,LLC) ; 

GEN2(50(*LDA*) tOtLLC) ; 

REPEAT 

STRGVARCFSYS  +  CC0MMA,RPARENTD,FALSE) 5 

TEMPLGTH  :=  TEMPLGTH  +  GATTR.TYPTR'^.MAXLENG  J 

IF  TEMPLGTH  <  STRGLGTH  THEN  GENLDC { TEMPLGTH) 

ELSE  GENLDC(STRGLGTH); 

GEN2(77(*CXP*)«0(*SYS*) ,23{ *SCONCAT*) ) ; 

GEN2(50(*LDA*) iO»LLC); 

TEST  :=  SY  <>  COMMA; 

IF  NOT  TEST  THEN  INSYMBOL 
UNTIL  TEST; 
IF  TEMPLGTH  < 

LC  :=  LLC  + 
ELSE  TEMPLGTH 
IF  LC  >  LCMAX 
LC  :=  LLC; 
WITH  GATTR  DO 

BEGIN  NEW (TYPTR, ARRAYS  I  TRUE* TRUE) 
TYPTR'*  :=  STRGPTR**; 
TYPTR'^.MAXLENG  :=  TEMPLGTH 

END 
END  (*CONCAT*)  ; 


STP; 


STRGLGTH  THEN 
(TEMPLGTH  DIV 
:=  STRGLGTH; 
THEN  LCMAX 


CHRSPERWD)  +  1 


=  LC 


PROCEDURE 

copydelete; 

VAR  LLC; 

:  addrrange;  lsp: 

BEGIN 

IF  LKEY 

=  19  THEN 

BEGIN 

LLC  :=  LC; 

LC  : 

;=  LC  +  (STRGLGTH 

end; 

IF  LKEY 

<>  43  THEN 

BEGIN 

DIV  CHRSPERWD)  +  1 
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STRGVAK{FSYS  +  CCOMMAD.  LKEY  =  18); 
IF  LKEY  =  19  THEN 

BEGIN  LSP  :=  gattr.typtr; 

GEN2(50(*lDA*) t0,LLC) 

end; 
if  sy  =  comma  then  insymbol  else  error<20); 

end; 
expression(fsys  +  ccommad);  load; 
if  gattr.typtr  <>  nil  then 

if  gattr.typtr  <>  intptr  then  err0r(125); 
if  sy  =  comma  then  insymbol  else  error(20); 
expression(fsys  +  crparentd)?  load; 
if  gattr.typtr  <>  nil  then 

if  gattr.typtr  <>  intptr  then  err0r(125); 
if  lkey  =  19  then 

BEGIN 

GEN2(77(*CXP*),0(*SYS*),25{»SCOPY*))« 

GEN2(50(»LOA*)t0tLLC) ; 

IF  LSP'^.MAXLENG  <  STRGLGTH  THEN 

LC  :=  LLC  +  (LSP^.MAXLENG  DIV  CHRSPERWD)  +  1« 
IF  LC  >  LCMAX  THEN  LCHAX  :=  LC? 
LC  :=  LLC?  GATTR.TYPTR  :=  LSP 
END 
ELSE 

IF  LKEY  =  43  THEN 

GEN2(77(*CXP*)tO(*SYS*)f29(*GQTOXY*)) 
ELSE  GEN2(77(*CXP*) t 0 ( *SYS*) f26 ( ♦SDELETE*) ) 
END  (*COPYDELETE*)  ; 

PROCEDURE  STR; 
BEGIN 

WITH  GATTR  DO 
BEGIN 

IF  COMPTYPES(LONGlNTPTRtTYPTR)  THEN 
ELSE  IF  TYPTR  =  INTPTR  THEN 
BEGIN 

GENL0C(18(*0CVT*) ) ;  GENNR (DECOPS) ; 
TYPTR  :=  LONGINTPTR 
END 
ELSE  ERR0R(125) ; 
IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR{20); 
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STRGVAR(r^YS    +    CRPARENTD,     TRUE); 
IF    STRGTYPt(TYPTR)     THEN 

BEGIN    GENLDCITYPTR'^.^AXLENG)  ;    GENLDC  ( 12  (  *DSTR*  )  )  5 

3ENrjp(L)EC0PS) 
END 
ELSE    ERR0R(116) ; 
END 
END    (*STR*); 

PROCEIDURE    close; 
BEGIN 

VARIABLECFSYS  +  CCOMMAi RPARENTD) ;  LOADADDRESS; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR'^, FORM  <>  FILES  THEN  ERR0R(125); 
IF  SY  =  COMMA  THEN 
BEGIN  INSYMBOL; 

IF  SY  =  IDENT  THEN 
BEGIN 
IF  ID  =  'NORMAL   •  THEN  GENLDC(O) 
ELSE 

IF  ID  =  'LOCK     »  THEN  GENLDC(l) 
ELSE 

IF  ID  =  'PURGE    •  THEN  GENLDC{2) 
ELSE 

IF  ID  =  'CRUNCH   »  THEN  GENLDC(3) 
ELSE  ERR0R(2) ; 
INSYMBOL 
END 
ELSE  ERR0R(2) 
END 
ELSE  GENLDC(O)  5 

GEN2{77(*CXP*) t0(*SYS*) .6(*FCL0SE*» ) ; 
IF  lOCHECK  THEN  GENl ( 30 ( *CSP* ) « 0 (*IOC*) ) 
END  (♦CLOSE*)  ; 

PROCEDURE  GETPUTETC; 
BEGIN 

\/ARlABLE(FSYS  +  CCOMMA  .  RRARENTJ )  ;  LOADADDRESS; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR^, FORM  <>  FILES  THEN  ERR0R(125) 

ELSE 
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44 

273^ 

13 

33  :i 

49 

2785 

13 

33:3 

49 

2786 

13 

33:4 

54 

2787 

13 

33:5 

54 

2788 

13 

33:5 

72 

2789 

13 

33:4 

78 

2790 

13 

33:3 

61 

2791 

13 

33:3 

67 

2792 

13 

33:2 

88 

2793 

13 

33:1 

92 

2794 

13 

33;i 

99 

2795 

13 

33:1 

06 

2796 

13 

33:3 

06 

2797 

13 

33:4 

11 

2798 

13 

33:3 

24 

2799 

13 

33:3 

30 

2800 

13 

33:2 

33 

2801 

13 

33:1 

35 

2802 

13 

33:1 

62 

2803 

13 

33:0 

68 

2804 

13 

33:0 

82 

2805 

13 

34:d 

1 

2806 

13 

34:0 

0 

2807 

13 

34  :i 

0 

2808 

13 

34:2 

5 

2809 

13 

34:1 

14 

2810 

13 

34:1 

28 

2811 

13 

34:2 

33 

2812 

13 

34:3 

33 

2813 

13 

34:3 

40 

2814 

13 

34:4 

44 

2815 

13 

34:4 

51 

2816 

13 

34:3 

59 

2817 

13 

34:2 

59 

2818 

13 

34:1 

62 

2819 

13 

34:i 

68 

2820 

13 

34;i 

33 

2821 

13 

34:2 

38 

2822 

13 

34:1 

98 

34: 
35: 
40: 


IF  GATTR.TYPTR-.FILTYPE  =  NIL  THEN  LRR0R{399); 
CASE  LKEY  OF 

32:   8lGI-n| 

IF  SY  =  COMMA  THEN 

BEGIN 

insymbol;  expressio(\i(Fsys  +  crparentd);  load; 

IF  GATTR.TYPTR  O  INTPTR  then  ERR0R(125) 
ENU 

ELSE  ERR0R{125) ; 

GENNR(SEEK) 
END; 

GEN2(77(*CXP*)iO(*SYS*)«7(*FGET*)) ; 

GEN2(77(*CXP*).0(*SYS*).8(*FPUT*)) J 

BEGIN 

IF  GATTR.TYPTR  <>  NIL  THEN 

rn^rnJyi^*"^^^^^"'''^'-^YP^  <>  CHARPTR  THEN  ERR0R(399); 
GENLDC(12)?  GENLDC(O); 

GEN2(77(*CXP*),0(*SYS*),17(*WRC*)) 

END 

Ef^O    (*CASE*)  ; 

IF  lOCHECK  THEN  GENl ( 30 ( *CSP* ) , 0 ( *IOC*) ) 
END  (*GETPUTETC*)  ; 

PROCEDURE  SCANJ 
BEGIN 

IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  <>  iNTPTR  THEN  ERR0R(125); 

IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 
IF  SY  =  RELOP  THEN 
BEGIN 

IF  OP  =  EQOP  THEN  GENLDC(O) 
ELSE 

IF  OP  =  NEOP  THEN  GENLDC(l) 
ELSE  ERR0R(125); 
INSYMBOL 
END 
ELSE  ERR0R{125) ; 

EXPRESSION{FSYS  +  CCOMMAD);  LOAD} 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  <>  CHARPTR 
IF  SY  =  COMMA  THEN  INSYMBOL 


THEN 
ELSE 


ERR0R(125); 
ERROR(20) ; 
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12 
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lo 

3i:i 
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32 
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35 
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43 
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2829 
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2830 

13 

31:1 
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13 
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13 
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71 

2833 

13 

35:d 

1 
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13 

35:0 

0 

2835 

13 

35:1 

0 

2836 

13 

35:1 

15 

2837 

13 

35:2 

20 

2838 

13 

35:2 

27 

2839 

13 

35:3 

32 

2810 

13 

35:1 

11 

28«+l 

13 

35:1 

58 

28f2 

13 

35:1 

73 

28«f3 

13 

35:1 

87 

28t4 

13 

35:1 

02 

2845 

13 

35  :i 

11 

2816 

13 

35:2 

16 

2817 

13 

35:3 

19 

2818 

13 

35:3 

31 

2819 

13 

35:2 

10 

2850 

13 

35:1 

13 

2851 

13 

35:1 

19 

2852 

13 

35:1 

61 

2853 

13 

35:1 

70 

2851 

13 

35:1 

75 

2855 

13 

35:1 

83 

2856 

13 

35:0 

83 

2857 

13 

35:0 

98 

2858 

13 
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1 
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13 

36:d 
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13 

36:o 
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13 
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13 

36:2 
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2863 

13 
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21 

BYTEADDRESS; 


VARIAbLE(FSYS  +  C COMMA . RPARENT D ) 
IF  SY  =  COMmA  THEf^i 
BEGIN  liJSYr.aOL; 

EXPRRSSIONtFSYS  +  CRPARENT3);  LOAD 
END 
ELSE  GENLDC(O)  '• 
(9EN1(30(*CSP*)  »11{*SCN*)  ) ; 
3ATTR.TYPTR  :=  INTPTR 
END  (*SCAN*)  ; 

PROCEDURE  BLOCKIO; 
BESIN 

VARIABLE(FSYS  +  CCOMMAD);  LOADADDRESS; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR'*. FORM  <>  FILES  THEN  ERR0R(125) 
ELSE 

IF  GATTR.TYPTR". FILTYPE  <>  NIL  THEN  ERR0R{399); 
IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR<20)J 
V/ARIABLE(FSYS  +  CC0MMA3)  J  BYTEADDRESS; 
IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20)! 
EXPRESSION(FSYS  +  CCOMMAt RPARENT3) ;  LOAD; 
IF  GATTR.TYPTR  <>  INTRTR  THEN  ERR0R(125); 
IF  SY  =  COMMA  THEN 
BEGIN  INSYMBOL; 

EXPRESSI0N(FSYS  +  CRPARENT3);  LOAD; 
IF  GATTR.TYPTR  <>  INTPTR  THEN  ERR0R(125) 
END 
ELSE  GENLDC(-l) ; 
IF  LKEY  =  37  THEN  GENLDC ( 1 )  ELSE  GENLDC(O); 

genldc(O);  genldc(O); 
sen2{77(*cxp*)«0(*sys*) i 28 ( ♦blockio*) ) ; 

IF  lOCHECK  THEN  GENl ( 30 ( *CSP*) » 0 ( *IOC* ) ) ; 
GATTR.TYPTR  ;=  INTPTR 
END  (*BLOCKIO*)  ; 


PROCEDURE  SIZEOF! 

VAR  LCP:  CTP; 
BEGIN 

IF  SY  =  IDENT  THEN 
BEGIN  SEARCHID(VARS 
IF  LCP-^.IDTYPE  <> 


+  ETYPEStFIELDDtLCP) ; 

NIL  THEN 


INSYMBOL; 
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36:2 

36  :i 
3&:fj 
36:o 
2f:o 
21: 

24: 
24; 
24; 


24 
24 
24 
24 
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1 
1 
1 

:i 
;i 
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:i 

:i 

:i 
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24:i 
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24  :i 
24:i 
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32 
34 
34 
50 
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0 
3 
7 
11 
15 
19 
23 
27 
31 
31 
35 
39 
43 
47 
47 
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34 

34  ( 
34  { 
34 

34  ( 

34  ( 

34 
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0 

0 

3 

10 

21 

35 

39 

50 

64 

78 

1 


GENLDC(LCP'^.IDTYPE'^,SIZE*CHRSPERWD) 

end; 
gattr.typtr  :=  intptr 

EfO  (*SIZEOF*)  ; 

BEGIN  (*ROUTINE*) 
CASE  lKEy  of 

12;     newstmt; 

13,14:    UNITio; 
15:       C0NCAT5 
18»i9»43:C0PYDELETE; 
21,22,27:M0VE; 

23:     EXIT; 
31:      CLOSE; 
32»34, 


35,40: 

36: 

37,38: 

'+1: 
42: 

END  (♦CASES*) 
END  (*R0UTINE*)  ; 


6ETPUTETC; 

SCAN; 

BLOCKIOI 

SIZEOFJ 

STR 


♦  fl 

♦  $I 

* 


«5:booypart.b.text*) 

tt5:B0DYPART.C.TEXT*) 

COPYRIGHT  <C)  1979,  REGENTS  OF  THE 
UNIVERSITY  OF  CALIFORNIA*  SAN  DIEGO 


*) 
♦  ) 


PROCEDURE  L0ADIDADDR(FCP:  CTP) ; 
BEGIN 

WITH  FCP-^  DO 

IF  KLASS  =  ACTUALVARS  THEN 

IF  VLEV  =  1  THEN  GENl (37( *LAO*) t VADDR ) 
ELSE  GEN2(50(*LDA*) ,LEVEL-VLEV«VADDR) 
ELSE   (*FORMALVARS*) 

IF  VLEV  =  1  THEN  GENl ( 41 { ♦LDO*) t VADDR) 
ELSE  GEN2(54(*L0D*) ,LEVEL-VLEViVADDR) 
END  (*L0ADIDADDR*)  ; 

PROCEDURE  READ; 
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2907 
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13 
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32 

2910 

13 

38:5 

39 

2911 

13 

33:6 

47 

2912 

13 

38:7 

53 

2913 

13 

38:7 

64 

29m 

13 

38:6 

69 

2915 

13 

38:2 

72 

2916 

13 

38  :i 

72 

2917 

13 

38:2 

74 

2918 

13 

38  :i 

83 

2919 

13 

38:2 

92 

2920 

13 

38:3 

92 

2921 

13 

38:4 

95 

2922 

13 

38:4 

08 

2923 

13 

38:4 

17 

292<+ 

13 

38:4 

19 

2925 

13 

38:5 

24 

2926 

13 

38:6 

33 

2927 

13 

38:5 

36 

2928 

13 

38:6 

40 

2929 

13 

38:7 

50 

2930 

13 

38:6 

51 

2931 

13 

38:7 

55 

2932 

13 

38:8 

65 

2933 

13 

38:9 

69 

293^1 

13 

38:8 

70 

2935 

13 

38:7 

72 

2936 

13 

38:8 

74 

2937 

13 

38:9 

84 

2938 

13 

38:8 

87 

2939 

13 

38:9 

91 

2910 

13 

38:o 

99 

2941 

13 

38:i 

04 

2942 

13 

38:o 

07 

2943 

13 

38:9 

09 

2944 

13 

38:4 

15 

VAR  FILEPTRiLCp:  CTP; 
BEGlfi  FILEPTR  :=  INPUTPTR; 

IF  (SY  =  IDENT)  AND  WASLPARENT  THEN 
3E5IiJ  SEARCHID(VAKS+CFIELDD,LCP)  ; 
IF  LCP'^.IDTYPE  <>  NIL  THEN 

IF  LCP'^.IDTYPE'^.FORVI  =  FILES  THEN 

IF  LCP'^.IDTYPE'.FILTYPE  =  CHARPTR  THEN 
BEGIN  INSYMBOl;  FILEPTR  :=  LCP; 

IF  NOT  (SY  IN  CCOMMA»RPARENTD)  THEN  ERROR{20); 
IF  SY  =  COMMA  THEN  INSYM30L 
END 
END 
ELSE 

IF  WASLPARENT  THEN  ERR0R{2); 
IF  WASLPARENT  AND  (SY  <>  RPARENT)  THEN 
3EGIN 

REPEAT  LOADIDADDR(FILEPTR)! 

VARIABLE(FSYS  +  CCOMMA, RPARENT3) J 

IF  GATTR, ACCESS  =  BYTE  THEN  ERROR(103); 

LOADADDRESSs 

IF  GATTR. TYPTR  <>  NIL  THEN 

IF  COMPTYPESdNTPTR, GATTR. TYPTR)  THEN 
GEN2(77(*CXP*) i 0 ( *SYS*) . 12 (*FRDI*) ) 
ELSE 

IF  COMPTYPES(REALPTR, GATTR. TYPTR)  THEN 

GENNR(FREADREAL) 
ELSE 

IF  COMPTYPES(LONGINTPTRiGATTR. TYPTR)  THEN 
BEGIN  GEWLDC(GATTR. TYPTR". SIZE) ; 

GENNR(FREADDEC) 
END 

ELSE 

IF  COMPTYPES(CHARPTR, GATTR. TYPTR)  THEN 

GEN2(77(*CXP*).0(*SYS«) ,16(*FRDC*) ) 
ELSE 

IF  STRGTYPE(GATTR. TYPTR)  THEN 

BEGIN  GENLDC(GATTR. TYPTR". MAXLENG) 5 

GEN2(77(*CXP*),0(*SYS*) tl8(*FRDS*) ) 
END 
ELSE  ERR0R(125) ; 
IF  lOCHECK  THEN  GENl ( 30 (*CSP* ) t 0 ( *I0C*) ) ; 
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39: 
39: 
39; 
39: 
39; 
39; 
39; 
39: 
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TEST  :=  5Y  <>  comma; 
IF  NOT  TCST  THEN  INSYMBOL 
UNTIL  TEST 

IF  LKEY  =  2  THEN 

3ESIN  LOADIDADDR(FILEPTR) ; 

GEN2(77(*CXP*)  tO(*SYS*)  f21(*FRLI\l*)  )  ; 

IF  lOCilECK  THEN  GENl  (  30  (  ♦CSP*  )  ,  0  (  *I0C*  )  ) 

END 
END  (*READ*)  ; 

PROCEDURE  WRITE; 

VAR  LSP:  STP;  DEFAULT:  BOOLEAN; 

FILEPTR,LCp:  CTP;  LEN,LMINtLMAx:  INTEGER! 
BEGIN  FILEPTR  :=  OUTPUTPTR; 

IF  (SY  =  IDENT)  AND  WASLPARENT  THEN 

BEGIN  SEARCHID(VARS  +  CFIELD.KONSTt FUNC 3, LCP) ; 
IF  LCP'^.IDTYPE  <>  NIL  THEN 

IF  LCP'^.IDTYPE^.FORM  =  FILES  THEN 

IF  LCP-,IDTYPE'",FILTYPE  =  CHARPTR  THEN 
BEGIN  INSYMBOL;  FILEPTR  :=  LCP; 

IF  NOT  (SY  IN  CC0MMAfRpARENT3)  THEN  ERROR(20)? 
IF  SY  =  COMMA  THEN  INSYMBOL 
END 

end; 
if  waslparent  anu  (sy  <>  rparent)  then 

3EGIN 

REPEAT  LOADIDADDR(FILEPTR) ; 

EXPRESSI0N(FSYS  +  CCOMMA iCOLONt RPARENTD) ; 

LSP  :=  gattr.typtr; 

IF  LSP  0  NIL  THEN 
WITH  LSP**  DO 
BEGIN 

IF  FORM  >  LONSINT  THEN  LOADADDRESS 
ELSE 

BEGIN  load; 

IF  FORM  =  LONGINT  THEN 

BEGIN  GENL0C{DECSIZE(MAXDEC));  GENLDC ( 0 (*DAJ*) ) ; 

GENNR(DECOPS) 
END 
END 


399 


;oo 


2986 

13 

39 

1   o 

40 

2967 

15 

39 

:  4- 

HO 

2933 

13 

39 

15 

^5 

2989 

13 

39 

48 

2990 

13 

39 

■  r 

•  o 

61 

2991 

13 

39 

17 

66 

2992 
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13 
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13 
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13 
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0 

13 

3007 

13 
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8 

49 
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13 
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7 

52 
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13 
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57 
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13 
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58 
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13 
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13 

39: 
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5013 

13 
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7 

72 
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39: 
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13 
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33 
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13 
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13 
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31 

Ei-JD; 
IF  SY  =  COLOM  THEN 

BEGIN  insymbol; 

iXPRESSIONCFSYS  +  C COMMA , COLON i RPARENT 3 ) ; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  <>  INTPTR  THEN  ERROR(20); 
LOAD;  DEFAULT  :=  FALSE 
END 
ELSE  DEFAULT  :=  TRUE; 
IF  LSP  =  INTPTR  THEM 

BEGIN  IF  DEFAULT  THEN  GENLDC(O); 

GEN2(77(*CXP*) t0(*SYS*) tl3(*FWRI*) ) 
END 
ELSE 

IF  LSP  =  REALPTR  THEN 

BEGIN  IF  DEFAULT  THEN  GENLDC(O)? 
IF  SY  =  COLON  THEN 
BEGIN  INSYMBOL; 

t.XPRESSlON(FSYS  +  CC0MMA.RPARENT3)  ;  LOAD; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  <>  INTPTR  THEN  ERR0R{125) 
END 
ELSE  GENLDC{0)  ; 
GENNK(FWRITEREAL) 
END 
ELSE 

IF  COMPTYPES(LSP,LONGINTPTR)  THEN 

BEGIN  IF  DEFAULT  THEN  GENLDC(O);  GENNR ( FWRITEDEC ) 
ELSE 

IF  LSP  =  CHARPTR  THEN 

BEGIN  IF  DEFAULT  THEN  GENLDC(O); 

GEN2(77(*CXP*) »0(*SYS*) ,17(*FWRC*) ) 
END 
ELSE 

IF  STRGTYPE(LSP)  THEN 

BEGIN  IF  DEFAULT  THEN  GENLDC(O); 

GEN2(77(*CXP*) i0(*SYS*) «19(*FWRS*) ) 
END 
ELSE 

IF  PAOFCHAR{LSP)  THEN 
BEGIN  LMAX  :=  O; 
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3037 

13 

39:  4 

84 

30  38 

13 

39:4 

39 

3039 

13 

39:3 

93 

3040 

13 

39:2 

99 

SO'+l 

13 

39:1 

99 

3042 

13 

39:2 

06 

SO^+S 

13 

39:3 

09 

3044 

13 

39:3 

14 

3045 

13 

39:2 

20 

3046 

13 

39:0 

22 

3047 

13 

39:0 

40 

3048 

13 

40:d 

1 

3049 

13 

4o:o 

1 

3050 

13 

4o:d 

1 

3051 

13 

40. '0 

5 

3052 

13 

4o:o 

0 

3053 

13 

40  :i 

0 

3054 

13 

40:2 

5 

3055 

13 

40:3 

9 

3056 

13 

40:4 

16 

3057 

13 

40:2 

26 

3058 

13 

4o:i 

29 

3059 

13 

40:2 

34 

3060 

13 

40:3 

34 

3061 

13 

4014 

34 

3062 

13 

40:4 

43 

3063 

13 

40:4 

46 

3064 

13 

40:4 

59 

3065 

13 

40:5 

68 

3066 

13 

40:6 

72 

3067 

13 

40:7 

83 

IF  LSD-.INXTYPE  <>  NIL  THEN 

BEGIN  GtT30UNDS(LSP'^.INXTYPE,LMIN,LMAX)  ; 
LHAX  :=  LMAX  -  LMiN  +  l 

END; 

IF  3EFAULT  THEN  GENLDC ( LMAX ) 5 
GENLDC(LMAX) ; 

GEN2(77(*CXP*),0(*SYS*) f20(*FWRB*)) 

END 

ELSE  ERR0R{i25) ; 
IF  lOCHECK  THEN  GENl ( 30 ( *CSP* ) , 0 ( *IOC* ) )  ; 
TEST  :=  SY  <>  COMMA; 
IF  NOT  TEST  THEN  INSYM30L 
UNTIL  TEST; 
END; 
IF  LKEY  =  4  THEN  (*WRITELN*) 
3EGIN  LOADIDADDR(FILEPTR) ; 

GEN2(77(*CXP*)iO(*SYS*) ,22(*FWLN*)) ; 

IF  lOCHECK  THEN  GENl ( 30 ( *CSP* ) , 0 ( *IOC*) ) 

END 

END  (♦WRITE*)  ; 

PROCEDURE  CALLNOnSPECIAL; 
LA3EL  1; 

VAR  nxt,lcp:  CTP5  LSP:  stp;  lb:  boolean; 

LMIN,LMAX:  integer; 
BEGIN 

WITH  FCP**  DO 

BEGIN  NXT  :=  NEXT; 

IF  PFDECKIND  =  DECLARED  THEN 

IF  PFKIND  <>  ACTUAL  THEN  ERROR(400) 
END; 

IF  SY  =  LPARENT  THEN 

BEGIN 

REPEAT 

IF  NXT  =  NIL  THEN  ERR0R(126); 

INSYMBOL; 

EXPRESSI0N(FSYS  +  C COMMA , RPARENT D ) ; 

IF  (GATTR.TYPTR  <>  NIL)  AND  (NXT  <>  NIL)  THEN 

BEGIN  LSP  :=  nxt^.idtype; 

IF  (nXT^.kLASS  =  FORMALVARS)  OR  (LSP  <>  NIL)  THEN 
BEGIN 
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:02 


3068 

13 

40:8 

33 

50^3 

li 

^013 

■^Q 

3070 

13 

f+OIO 

96 

3071 

13 

'+0:1 

00 

3072 

13 

'+0:1 

06 

3073 

13 

4o:i 

0  8 

3071 

13 

40:2 

14 

3075 

15 

4o:i 

17 

3076 

13 

40:2 

21 

3077 

13 

40:3 

27 

3076 

13 

40:4 

27 

3079 

13 

40:5 

52 

3080 

13 

4o:6 

38 

3081 

13 

40:5 

38 

3082 

13 

40:4 

42 

3083 

13 

40:4 

46 

3081 

13 

40:4 

49 

3085 

13 

40:3 

50 

3086 

13 

40:2 

52 

3087 

13 

40:3 

54 

3068 

13 

40:3 

58 

3089 

13 

40:4 

63 

3090 

13 

40:5 

67 

3091 

13 

40:5 

71 

3092 

13 

40:4 

72 

3093 

13 

40:3 

74 

309*+ 

13 

40:4 

76 

3095 

13 

"+0:4 

79 

3096 

13 

40:5 

90 

3097 

13 

40:6 

93 

3098 

13 

40:5 

93 

3099 

13 

40:4 

97 

3100 

13 

40:5 

99 

3101 

13 

40:6 

09 

3102 

13 

4o:o 

09 

3103 

13 

40:9 

13 

3104 

13 

4o:o 

15 

3105 

13 

4o:i 

16 

3106 

13 

4o:i 

27 

3107 

13 

40  ;i 

29 

3108 

13 

40:2 

39 

IF    NXT'^.KLASS    =    ACTUALVARS    THETJ 

IF  GATTR.TYPTR'^.FORM  <=  POwER  THEN 
BEGIN  L3  :=  (GATTR.TYPTR  =  CHARPTR) 
AND  (GATTR.KIND  =  CST) ; 
LOAD? 
IF  LSP-^.FORM  =  POWER  THEN 

GEN1(32(*ADJ*)  ,LSP'*.SIZE) 
ELSE 

IF  LSP'^.FORM  =  LONGINT  THEN 
BEGIN 

IF  GATTR.TYPTR  =  IfvjTPTR  THEN 

BEGIN  GENLDC(18(*DCVT*) ) ;  GENNR ( DECOPS ) ; 

GATTR.TYPTR  :=  LONGINTPTR 
END? 
GENL0C(LSP'*,SI2E)  5 
GENLDC(0(*DAJ*))! 
GENNR(DECOPS) 
END 
ELSE 

IF  (LSP'^.FORM  =  SUBRANGE) 
AND  RANGECHECK  THEN 
BEGIN  GENLDC(LSP''.MIN.IVAL)  ; 
GENLDC(LSP*,MAX.IVAL) ; 
GEN0(8{*CHK*)) 
END 
ELSE 
IF  (GATTR.TYPTR  =  INTPTR)  AND 

COMPTYPES(LSP,REALPTR)  THEN 
BEGIN  GEN0(10(*FLT*)) J 

GATTR.TYPTR  :=  REALPTR 
END 
ELSE 

IF  LB  AND  STRGTYPE(LSP)  THEN 
GATTR.TYPTR  :=  STRGPTR 
END 
ELSE  (*FORM  >  POWER*) 

BEGIN  LB  ;=  STRGTYPE(GATTR.TYPTR) 

AND  (GATTR.KIND  =  CST) ; 
LOADADDRESS; 

IF  LB  AND  PAOFCHAR(LSP)  THEN 
IF  NOT  LSP'^.AISSTRNG  THEN 


3109 

15 

10:3 

14 

3110 

16 

10:1 

13 

jlll 

13 

10:5 

51 

3112 

13 

10:6 

51 

3113 

13 

ia:6 

63 

311*4 

13 

10:6 

66 

3115 

13 

10:5 

80 

3116 

13 

10:1 

80 

3117 

13 

10:3 

80 

3118 

13 

10:0 

83 

3119 

13 

10:8 

83 

3120 

13 

10:9 

85 

3121 

13 

10:0 

90 

3122 

13 

10:1 

90 

3123 

13 

10:1 

99 

3121 

13 

10:1 

01 

3125 

13 

10:2 

06 

3126 

13 

10:3 

13 

3127 

13 

10:3 

15 

3128 

13 

10:0 

23 

3129 

13 

10:9 

26 

3130 

13 

10;  8 

31 

3131 

13 

10:7 

17 

3132 

13 

10:5 

50 

3133 

13 

10:1 

50 

3131 

13 

10:3 

56 

3135 

13 

10:3 

61 

3136 

13 

10:2 

75 

3137 

13 

10:1 

78 

3138 

13 

Hoa 

87 

3139 

13 

10:2 

92 

3110 

13 

10:3 

99 

3111 

13 

10:1 

99 

3112 

13 

10:5 

06 

3113 

13 

10:1 

12 

3111 

13 

10:5 

16 

3115 

13 

10:6 

20 

3116 

13 

10:7 

33 

3117 

13 

10:6 

17 

3118 

13 

10:7 

19 

3119 

13 

10:7 

63 

BEGTJ    STRGTCPA(STRGCSTIC) ; 
IF    LSP'^.INXTYPt:    <>    NIL    THEN 

3EGIN 

GETBOUNDS{LSP''.I(gxTYPE.LMIN,LMAX); 
IF  LMAX-LMIN+1  <> 

GATTR.TYPTR-.MAXLENG  THEN  ERR0R(112); 
ENDJ 
GATTR.TYPTR  :=  LSP 
END 


END 


ELSE  (*KLASS  =  FORMALVARS*) 
IF  GATTR.KIND  =  VARBL  THEN 
BEGIN 

IF  GATTR. ACCESS  =  BYTE  THEN  ERROR(103); 

LOAOADDRESS; 

IF  LSP  <>  NIL  THEN 

IF  LSP'^.FORM  IN  CP0WeR»L0NGINT3  THEN 
IF  GATTR.TYPTR*. SIZE  <> 

LSP-". SIZE  THEN  ERR0R(112) 
END 
ELSE  ERR0R(151)J 
IF  NOT  COMPTYPES(LSP, GATTR.TYPTR)  THEN  ERR0R(112) 
END 

end; 

IF  NXT  <>  NIL  THEN  NXT  :=  NXT'^.NEXT 
UNTIL  SY  <>  COMMA; 

IF  SY  =  RPARENT  THEN  INSYMBQL  ELSE  ERROR(I) 
END  (*LPARENT*)  ; 
IF  NXT  0  NIL  THEN  ERR0R(126); 
WITH  FCP*  DO 

IF  PFDECKIND  =  DECLARED  THEN 
BEGIN 

IF  KLASS  =  FUNC  THEN 

BEGIN  GENLDC(O);  GENLDC(O)  END; 
IF  INMODULE  THEN 
IF  SEPPROC  THEN 

IF  (PFSEG  =  SEG)  AND  (PFlEV  =  1)  THEN 

BEGIN  GEN1{79(*CGP*).0);  LINKERREF (PROC »-PFNAMEf IC-1 )  END 
ELSE 

IF  PFLEV  =  0  THEN  GEN2 ( 77 ( *CXP* ), PFSEG . PFNAME ) 
ELSE  ERRORdOS)  (♦CALL  NOT  ALLOWED  IN  SEP  PROC*) 
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3150 

13 

'+o:b 

70 

3151 

13 

'+0:6 

75 

3152 

13 

40:7 

80 

3153 

13 

4o:6 

96 

3154 

13 

4o:4 

00 

3155 

13 

40:5 

02 

3156 

13 

4o:& 

0  9 

3157 

13 

'+0:5 

16 

3158 

13 

40:6 

20 

3159 

13 

"+0:6 

31 

3160 

13 

'+0:7 

35 

3161 

13 

40:7 

47 

3162 

13 

40:8 

51 

3163 

13 

40:8 

62 

3164 

13 

^0:3 

70 

3165 

13 

^+0:2 

72 

3166 

13 

«+o:3 

74 

3167 

13 

'+0:3 

83 

3168 

13 

'+0:3 

83 

3169 

13 

^+0:4 

87 

3170 

13 

10:5 

00 

3171 

13 

'+0:1 

06 

3172 

13 

^0:0 

09 

3173 

13 

'+0:0 

36 

3174 

13 

21:0 

0 

3175 

13 

21:1 

0 

3176 

13 

21:2 

7 

3177 

13 

21:3 

15 

3178 

13 

21:3 

20 

3179 

13 

21:4 

25 

3180 

13 

21:4 

31 

3181 

13 

21:3 

40 

3182 

13 

21:4 

54 

3183 

13 

21:3 

68 

3184 

13 

21:3 

69 

3185 

13 

21:3 

83 

3186 

13 

21:4 

87 

3187 

13 

21:4 

90 

3188 

13 

21:4 

94 

3189 

13 

21:4 

98 

3190 

13 

21:6 

98 
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ELSE 

IF  IMPORTED  THEM 

SEGIN  GEN2(77(*CXP*) .0,PFNAME) ;  LINKERREF ( PROC . PFSE&, IC-2 )  END 
ELSE  GOTO  1 
ELSE 
1:      IF  PFSES  0  SEG  THEN 

GEN2(77(*CXP*) . °FSEG t PFNAME ) 
ELSE 

IF  PFLEV  =  0  THEN  GENl (66 { *C8P* ) tPFNAME ) 
ELSE 

IF  PFLEV  =  LEVEL  THEN  GENl ( 78 ( *CLP* ) i PFNAME) 
ELSE 

IF  PFLEV  =  1  THEN  GENl ( 79( *CGP*) tPFNAME) 
ELSE  GEN1(46(*CIP*) tPFNAME) 
END 
ELSE 

IF  CSPNUM  =  23  THEN  GENl{30»«+0)   (♦  TEMP  1,5  TRANSLATION  -- 

MEM  WILL  BE  CSP  23  IN  II. 0   *) 
ELSE 

IF  (CSPNUM  <>  21)  AND  (CSPNUM  <>  22)  THEN 
GENl ( 30 (*CSP*)t CSPNUM) ; 

gattr.typtr  :=  fcp'^.idtype 
end  (*callnonspeclal*)  ; 

begin  {*call*) 
if  fcp'^.pfdeckind  =  special  then 
begin  waslparent  :=  true;  lkey  :=  fcp'^.key; 

if  sy  =  lparent  then  insymbol 

ELSE 

IF  LKEY  IN  C2,4,5i63  THEN  WASLPARENT  :=  FALSE 

ELSE  ERR0R(9); 
IF  LKEY  IN  C7»8»9,10fllfl3.14,25,36,39»'+2D  THEN 

BEGIN  EXPRESSION(FSYS  +  CCOMMA, RPARENT] ) }  LOAD  END? 
IF  LKEY  IN  Cl2tl3,14»l5»18«19. 21,22, 23»27i31,32t34i35,36*37»38f 

40t'+l,42i43D  THEN  ROUTINE(  LKEY  ) 
ELSE 

case  lkey  qf 
1,2:  read; 

3t4:  WRITE; 

5,6:  BEGIN  (*EOF  S  EDLN*) 
IF  WASLPARENT  THEN 


3191 

13 

21:7 

01 

3ly2 

13 

21:3 

15 

il93 

13 

21:9 

20 

319^ 

13 

2i:s 

27 

3195 

13 

2i:n 

32 

3196 

13 

21:0 

57 

3197 

13 

21:7 

46 

3198 

15 

21:0 

49 

3199 

13 

21:7 

51 

3200 

13 

21:6 

55 

3201 

13 

21:6 

61 

3202 

13 

21:6 

o9 

3203 

13 

21:6 

78 

3201+ 

13 

21:5 

78 

3205 

13 

2i:<+ 

84 

3206 

13 

21:6 

87 

3207 

13 

21:7 

92 

3208 

13 

21:8 

98 

3209 

13 

21:8 

04 

3210 

13 

21:7 

09 

3211 

13 

21:5 

14 

3212 

13 

2i:tf 

19 

3213 

13 

21:6 

19 

32m 

13 

21:7 

24 

3215 

13 

21:6 

34 

3216 

13 

21:5 

34 

3217 

13 

21:4 

39 

3218 

13 

21:6 

39 

3219 

13 

21:7 

44 

3220 

13 

21:7 

50 

3221 

13 

21:3 

54 

3222 

13 

21:8 

61 

3223 

13 

21:5 

72 

3221+ 

13 

21:4 

74 

3225 

13 

21:6 

74 

3226 

13 

21:7 

79 

3227 

13 

21  .-7 

85 

3228 

13 

21:8 

89 

3229 

13 

2i:s 

96 

3230 

13 

21:5 

07 

3231 

13 

21:4 

09 

BEGIN  VARIA3LE(FSYS  +  CRPARENT]);  LOADADDRESS; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR-.FORM  <>  FILES  THEN  ERR0R(125) 
ELSE 

IF  (GATTR.TYPTR'^.FILTYPE  <>  CHARPTR)  AND 
(LKEY  =  6)  THEN  ERR0R(399) 
END 
ELSE 

LOADIDADDRdNPUTPTR)  ; 
GENLDC(O);  GCNLDC(O); 

IF  LKEY  =  5  THEN  GEN2 ( 77 ( *CXP*) , 0 { *SYS* ) , 10 { *FEOF* ) ) 
ELSE  GEN2{77(*CXP*),0(*SYS*),H(*FEOLN*)); 
GATTR.TYPTR  :=  BOOLPTR 
END  {*EOF*)  ; 
7,8:  BEGIN  GENLDC(l);  (♦PREDSUCC*) 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR^. FORM  =  SCALAR  THEN 
IF  LKEY  =  8  THEN  GENO (2 { ♦ADI* ) ) 
ELSE  SE'\I0(21(*SBI*)  ) 
E-LSE  ERR0R(115) 
END  (*PREDSUCC*)  ; 
9:  BEGIN  (*ORD*) 

IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR'^. FORM  >=  POWER  THEN  ERR0R(125); 
GATTR.TYPTR  :=  INTPTR 

End  (*ord*)  ; 
10:  begin  (*sor*) 

IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  =  INTPTR  THEN  GENO (24(*SQI* ) ) 

ELSE 

IF  GATTR.TYPTR  =  REALPTR  THEN  GENQ (25( *SQR*) ) 
ELSE  BEGIN  ERR0R{125);  GATTR.TYPTR  ;=  INTPTR  END 
END  (*saR*)  ; 
ll;  BEGIN  (*ABS*) 

IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  =  INTPTR  THEN  GENO ( 0 ( *ABI*) ) 
ELSE 

IF  GATTR.TYPTR  =  REALPTR  THEN  GENO ( 1( *ABR* ) ) 
ELSE  BEGIN  ERR0R(125);  GATTR.TYPTR  :=  INTPTR  END 
END  (*ABS*)  ; 
16:  BEGIN  (*LENGTH*) 
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32i2 

15 

2i:b 

09 

3235 

13 

2i:6 

22 

4231+ 

13 

21:5 

28 

3235 

13 

2i:i+ 

35 

3236 

13 

21:6 

35 

3237 

13 

21:6 

46 

5238 

13 

21:5 

SO 

3259 

13 

21:6 

75 

52ifO 

13 

21:6 

73 

sam 

13 

21:6 

92 

32'+2 

13 

21:6 

06 

32^3 

13 

21:7 

11 

32'+'+ 

13 

21:6 

20 

52'+5 

13 

21:5 

25 

3246 

13 

21*.'+ 

27 

32'+7 

13 

21:6 

27 

3218 

13 

21:6 

40 

iZ^S 

13 

21:6 

54 

3250 

13 

21:6 

67 

3251 

13 

21:6 

75 

3252 

13 

21:6 

78 

3253 

13 

21:5 

78 

325i+ 

13 

21:^+ 

83 

3255 

13 

21:6 

83 

3256 

13 

21:6 

97 

3257 

13 

21:6 

11 

3258 

13 

21:6 

25 

3259 

15 

21:5 

27 

3260 

13 

21:1 

31 

3261 

13 

21:6 

31 

3262 

13 

2i;6 

45 

3263 

13 

2i:& 

59 

326^+ 

13 

21:6 

75 

3265 

13 

21:6 

87 

3266 

13 

21:6 

90 

3267 

13 

21:5 

92 

3268 

13 

21:4 

96 

3269 

13 

21:6 

96 

3270 

13 

21:6 

10 

3271 

13 

21:7 

15 

3272 

13 

2i:& 

24 

9TKGVAR(FSYS  +  C RPAREHT D 1  FALSE ) ; 

GENLDC(0(*IMOEX*) );  GENO ( 62 ( ♦LD3* ) ) ;  GATTR.TYPTR 
ElvlD  (*LENGTH*)  5 
17:  3ESIN  (♦INSERT*) 

STKGVAR(FSYS  +■  C  COMMA  ]  1  FALSE  )  ; 

IF  SY  =  COmA    THEN  IMSYMBOL  ELSE  ERROR(20); 

STKGVAR(FSYS  +  CCOMMAD1TRUE) ; 

GENLDC(GATTR.TYPTR'".MAXLENG)  ; 

IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR{20); 

EXPRESSI0N{FSYS  +  CRPARENTD);  LOAD? 

IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  <>  INTPTR  THEN  ERR0R(125); 

GEN2(77(*CXP*) , 0 ( *SYS* ) f 24 ( *SINSERT* ) ) 
END  C+INSERT*)  ; 
20:  BEGIN  (tPOS*) 

STRGVAR{FSYS  +  C COMMA D. FALSE ) ; 

IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 

STKGVAR(FSYS  +  CRPARENT 3, FALSE ) ; 

GENLDC(O);  GENLOC(O); 

GEN2(77(*CXP*) , 0 ( *SYS* ) t 27 ( *SPOS* ) ) ; 

GATTR.TYPTR  :=  INTPTR 
END  (*POS*)  ; 
24:  BEGIN  (*IDSEARCH*) 

VARIABLE(FSYS  +  CCOMMA^);  LOADADDRESS? 

IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 

VARIABLE(FSYS  +  CRPARENT3);  LOADADDRESS; 

GEN1(30(*CSP*) t7(*IDS*) ) 
END  (*IDSEARCH*)  ; 
25:  BEGIN  (*TREESEARCH*) 

IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 

VARIABLE(FSYS  +  CCOMMAD);  LOA0ADDRESS5 

IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 

VARIABLE(FSYS  +  CRPARENTD);  LOADADDRESS; 

GATTR.TYPTR  :=  INTPTR; 

GEN1(30(*CSP*) i8(*TRS*) ) 
END  (*TREESEARCH*)  ; 
26:  BEGIN  (*TIME*) 

VARIABLE(FSYS  +  CCOMMAJ);  LOADADDRESS; 

IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  <>  INTPTR  THEN  ERR0R(125); 
IF  SY  =  COMMA  THEN  INSYMBOL  ELSE  ERROR(20); 


406 
;=  INTPTR 


3273 

527it 

3275 

3276 

1,277 

3276 

3279 

3280 

3231 

3232 

3283 

3284 

3285 

3286 

3287 

3238 

3289 

3290 

3291 

3292 

3293 

329tf 

3295 

3296 

3297 

3298 

3299 

3300 

3301 

3302 

3303 

SSO't 

3305 

3306 

3307 

3308 

3309 

3310 

3311 

3312 

3313 


13 

13 

15 

13 

1.5 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 


21 

21 

kl 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21: 

2i:6 

2i:7 

21 : 8 

21:7 

21:6 

21:7 


:7 

•  ^ 

:5 
:4- 

•  •- 

•  D 

:6 
:7 

•  o 
17 

13 

:7 

16 
17 

:3 
ra 
:9 
:3 

id 

:7 
:6 

15 

14 


21:3 
21:8 
21:7 

21:8 
21:9 
21:0 


21; 

21; 
21; 

21! 
21: 


33 

52 

b7 

66 

63 

72 

72 

66 

91 

01 

36 

11 

14 

19 

24 

27 

40 

49 

50 

57 

63 

65 

71 

75 

75 

80 

83 

83 

87 

92 

98 

00 

00 

04 

10 

10 

14 

16 

22 

22 

25 


VAKIABLE:(FSYS  +  CRPARENTD);  loadaddress; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  <>  INTPTR  THEN  ERR0R(125); 
GEN1(30(*CSP*)  ,9(*TIiV|*)  ) 
C'JD  (*TIME*)  ; 
33.23»29t3Q:  3EGIN  ( *OPEN t RESET t REWRITE* ) 

VARIABLE(FSYS  +  CCOMMA tRPARENTD) ;  LOADADDRESS; 
IF  GATTR.TYOTR  <>  NIL  THEN 

IF  bATTR.TYPTR'^.FORM  <>  FILES  THEN  ERR0R(125); 
IF  SY  0  COMMA  THEN 
IF  LKEY  =  33  THEN 

GEN2{77(*CXP*) »0<*SYS*) »4(*FRESET*) ) 
ELSE  ERROR(20) 
ELSE 

BEGIN  INSYi^^SOL; 

STRGVAR(FSYS  +  CRPARENT3, FALSE ) ; 
IF  (LKEY  =  28)  OR  (LKEY  =  30)  THEN 

GENLDC(O) 
ELSE  GENLDC(l); 

GENLDC(O) ;  GEN2(77(*CXP*)»0(*SYS*),5(*FOPEN*)) 
END; 
IF  IOCHECk  THEN  GENl (30 ( *CSP* ) » 0 (♦lOC* ) ) 
END  (*OPEN*)  ; 
39:  BEGIN  (*TRUNC*) 

IF  GATTR.TYPTR  =  INTpTR  THEN 
BEGIN  GENO(10(*FLT*) ) ; 

GATTR.TYPTR  :=  REALPTR 
END; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR  =  REALPTR  THEN 

GEN1(30(*CSP*) »23{*TRUNC*) )  {*♦♦  TEMPORARY  -- 

TRUNC  WILL  BE  CSP  14  IN  II, O  ***) 
ELSE 

IF  GATTR.TYPTR'^.FORM  =  LONGINT  THEN 
BEGIN 

GENL0C(20(*DTNC*) ) ;  GENNR (DECOPS ) 
END 
ELSE  ERR0R(125); 
GATTR.TYPTR  :=  INTPTR 
END 
END  (*SPECIAL  CASES*)  ; 
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lilt       ]l  ^^'^  ^^  ^^    WASLPAKENT    THEN                                                                                                                                   '^^^ 

3il6       li  21-P  J'  ^^    -^    "    RPARtNT    THEN    INSYM30L    ELSE    ERR0R(4) 

3317  l\  ^i.*f  ?a  ^'^"^     (*SPECIAL    PP/JCEjURES    AfJD    FUNCTIONS*) 

^•316  15  2i:o  31  END    (*CALL*)     ; 

ll^l  ^'l  i^'°  ^'*  <**^     rfS:iOOYPART,C.T£XT*) 

^xo?  ,^  i^'^  S'^  (*$I    f*5:300YPART.L).TEXT*) 

3320  13  2i:j  54 

3322  J^  pJ:2  ^,''  **            COPYRIGHT     (C)     1979.    REGENTS    OF    THE                       *) 

5225  il  li'io  54  ^*            'UNIVERSITY    OF    CALIFORNIA,    SAN    DIEGO                    *) 

3325  ]l  Jp.'^  i  Pf^QCEDURE    EXPRESSION  ( *FSYS :    SETOFSYS*); 

332A  7?  Tq:^  !  "-^^^^    ^''             '*    STRirgG    COMPARE    KLUDGE    *) 

3327  il  il'n  ip  ^^^  "'^II^-  '^■^^'''  '-"''=  operator;  typind:  integer; 

3328  13  i9^n  ]l  lstrgic.lsize:  addrrange;  lstring.gstring:  boolean; 
332I  II  llli  18  L.iN,LMAx:  integer; 

33!?  II  lll^o  I  BEGl"''^^  FLOATIKVAR  FSP:  STP;  FORCEFLOAT:  BOOLEAN)! 

3333  II  lul  14°  '^egJn^''*"'''^"  "  REALPTR)  OR  (FSP  =  REALPTR)  OR  FORCEFLOAT  THEN 

?335  II  IV'I  10  ^^    GATTK.TYPTR  =  INTPTR  THEN 

333,  ^-3^  II  ^/ni^r.V.T/.'d*''''    ^^-«-^--    -    -ALPTR    ENO; 

3338  I3  IWl  39  ^,^0    ^"^'^    GEN0(9{*FLO*));    FSP    :=    REALPTR    END 

im  il  "^^'^  ^^  ^N°  (*FLOATIT*)  ; 

3340  13  11:0  52 

nil  ]l  a?:S  i  PROCEDURE  STRETCHIT ( VAR  FSP:  STP); 

oi'+g  13  '+2;o  0  begi^j 

|:j  If  till  ,1  '^r^^;T^??:p;.^?^?;?Ji."?H^s""•^^^^^'•"^''  =  ^°"""'  ^"« 

33^6  13  Jsil  27  _J^""  '=^"l-D':'"<»D"T.,,i  GENNR(DEC0PS)1  GATTR.TYPTR  :r  L0N6INTPTR  END 

33*a  13  IV-l  3s  '  '"  "'■  =  ^''''"''  ^""" 

33*9  13  'aiJ  '5  END  ,  .STREt'cHI?'?'-' "' '  *°"*' "  ^^►"""D"OPS.  i  FSP  :=  LONSINTPTR  END 

3350  13  ^+2:0  58 

335^  \\  IV-n  i  PROCEDURE  SIMPLEEXPRESSION  ( FSYS :  SETOFSYS); 

3353  ^3  H\l  J  ^'^^  ^'^^^^''    ^^^^'    ^°^'  OP^^'^TOR'  SIGNED:  BOOLEAN; 


3355 

3356 

3357 

335S 

3359 

3360 

3361 

3362 

3363 

3361 

3365 

3366 

3367 

3368 

3369 

3370 

3371 

3372 

3373 

337«+ 

3375 

3376 

3377 

3378 

3379 

3380 

3381 

3382 

3383 

3384 

3385 

3386 

3387 

3388 

3389 

3390 

3391 

3392 

3393 

3394 


13 

1.5 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 


4  4:0 

44:3 

45:0 
4b:„ 
^+5:0 

f5:o 

'+5:2 
'♦5:3 
'+5:2 
45:1 
'+5:2 
^+5:3 
'+5:3 
15:4 
^^5:5 

'+5:6 

'+5:6 

f5:7 

'+5:8 

45:9 

^5:8 

'+5:6 

'+5:5 

f5:6 

f5:7 

'+5:4 

«+5:3 

'+5:4 

'+5:5 

•+5:6 

f5:7 

'+5:6 

'+5:5 

45:4 

'+5:3 

1+5:4 


1 

5 

12 

1 

5 
9 

14 
0 
0 
10 
30 
30 
33 
42 
42 
45 
45 
54 
57 
6*+ 
77 
79 
86 
89 
97 
99 
05 
17 

22 

25 

32 

39 

39 

39 

39 

45 

47 

51 

51 

56 

56 


°RDC£DURE  TER?J!(FSYS:  SETOFSYS); 

VAR  latth:  attk;  lsp:  stp;  lop:  operator; 

PROCEDURE  FACTOR(FSYS:  SETOFSYS); 

"''  LSP-  llp'    MTriuJfVn''''''''''^^^"^^'^--  boolean; 

clTPAR%'rSErorL''l27T''''''°'=  ^''""' 

BEGIN 

IF  NOT  (SY  IN  FACBEGSYS)  THEN 

BEGIN  ERR0R(58);  SKIP(FSYS  +  FACBEGSYS); 
GATTR.TYPTR  :=  NIL  dcoot;,;, 

end; 

while  SY  IM  FACBEGSYS  DO 
BEGIN 

CASE  SY  OF 

(*iD*)  ioent: 

''insymbSl;"'''''°'''''°'"'''''''^ 

if  LCP^.KLASS  =  FUNC  THEN 

begin  CALL{FSYS,LCP);  GATTR.KIND  :=  EXPR  END 
EL«t. 

IF  lcp-.klass  =  konst  then 

WITH  GATTR*  LCP^    do 

begin  typtr  :=  idtype;  kind  :=  cstj 

CVAL  :=  VALUES 
END 

ELSE  SELECT0R(FSYS,LCP); 
if  GATTR.TYPTR  <>  NIL  THEN 
WITH  GATTR, TYPTR"  QO 
end;  ^^    ^°^^    ""  SUBRANGE  THEN  TYPTR  :=  RANGETYPE 

(♦csT*)  intconst: 

BEGIN 

WITH  GATTR  do 

BEGIN  TYPTR  :=  INTPTR;  KIND  :=  CST; 
CVAL  :=  VAL 

END; 

insymbol 
End? 
realconst: 

BEGIN 
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410 


3395 

3397 

3398 
^399 
3400 

3*^02 
3403 
3404 
3405 
3406 
3407 
3408 
3409 
3410 
3411 
3412 
3413 
3414 
3415 
3416 
3417 
3416 
3419 
3420 
3421 
3422 
3423 
3424 
3425 
3426 
3427 
3428 
3429 
3430 
3431 
3432 
5433 
3434 
3435 


13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 
13 


45 

45 

45 

45 

45 

45 

45:3 

45:4 

45:5 


45: 
45; 
45; 
45; 
45; 
45; 
45; 
45: 
45: 
45; 
451 
45; 
45: 


45:4 

45:5 

45:6 

45:7 

45:7 

45:7 

45:6 

45:5 

45:4 

45:3 

45:4 

45:5 

45:4 

45 

45 

45 

45 

45 

45 


b6 
Do 
63 
65 
69 
69 
74 
74 
74 
74 
74 
80 
36 
91 
96 
02 
02 
05 
10 
14 
14 
19 
19 
19 
19 
24 
29 
38 
46 
50 
50 
55 
55 
70 
81 
86 
86 
86 
98 
08 
10 


KIND  :=  CST 


:=  CHARPTR 


(*(*) 


(*NOT*) 


WITH  GATTR  DO 

bEGIN  TYPTK  :=  REALPTR; 

CVAL  :=  VAL 
END; 
INSYMBOL 
ENDS 
STRIiJGCONST: 

3EGIN 

WITH  GATTR  DO 
BEGIN 

IF  LGTH  =  1  THEN  TYPTR 
ELSE 

BEGIN  NEiAl(LSPtARRAYS»TRUE»TRUE)  ; 
LSP**  :=  STRGPTR**; 
LSP'^.MAXLENG  :=  LGTH; 
TYPTR  :=  LSP 
END; 
KIND  :=  CST;  CVAL  :=  VAL 
END; 

insymbol 
end; 
longconst: 

BEGIN 

WITH  GATTR  00 

BEGIN  NEW(LSP.LONGINT) ; 
LSP^  ;=  LONGINTPTR''; 

LSP-'-siZE  :=  decsize(lgth)  ; 

TYPTR  :=  LSP;  KIND  :=  CST;  CVAL  :=  VAL 

END; 
insymbol 

end; 
lparent: 
begin  insymbol;  expressi0n(fsys 
if  sy  =  rparent  then  insymbol 
end; 
notsy: 
with  gattr  do 
begin  insymbol;  factortfsys) ; 

if  (kind  =  cst)  and  (typtr  =  boolptr)  then 
cval.ival  :=  ord(not  odd ( cval. ival) ) 

ELSE 


+  CRPARENT3) ; 
ELSE  ERR0R(4) 


3^36 

13 

45:7 

14 

3^+37 

13 

45:8 

19 

3138 

13 

45:9 

24 

jf+sg 

13 

4b  :o 

30 

3f'+0 

13 

45:7 

39 

3441 

13 

45:5 

39 

3442 

13 

45:3 

41 

3443 

13 

45:4 

41 

3444 

13 

45:5 

54 

3445 

13 

45:5 

59 

3446 

13 

45:& 

62 

3447 

13 

45:5 

78 

3448 

13 

45:6 

83 

3449 

13 

45:7 

83 

3450 

13 

45:8 

83 

3451 

13 

45:7 

89 

3452 

13 

45:6 

89 

3453 

13 

45:5 

92 

3454 

13 

45:6 

94 

3455 

13 

45:7 

94 

3456 

13 

45:8 

12 

3457 

13 

45:9 

17 

3458 

13 

45:0 

23 

3459 

13 

45:9 

32 

3460 

13 

45:0 

34 

3461 

13 

45:1 

44 

3462 

13 

45:2 

50 

3463 

13 

45:2 

53 

3464 

13 

45:3 

59 

3465 

13 

45:4 

62 

3466 

15 

45:4 

65 

3467 

13 

45:3 

65 

3468 

13 

'^5:2 

68 

3469 

13 

45:2 

73 

3470 

13 

45:3 

78 

3471 

13 

45:4 

84 

3472 

13 

45:4 

02 

3473 

13 

45:4 

12 

3474 

13 

45:5 

14 

3475 

13 

45:4 

23 

3476 

13 

45:5 

26 

btGIN  LOAO;  GENO(19{*NOT*) ) ; 
IF  TYPTR  <>  rJIL  THEN 

IF  TYPTR  <>  BOOLPTR  THEN 

BEGIN  ERR0R(135);  TYpTR  :=  NIL  END 

END; 
(*C*)    L3RACK: 

BEGIN  INSYMBOL;  CSTRART  :=  n  3;  VARPART  :=  FALSE? 
NEW(LSP, POWER)  ; 
WITH  LSP^  DO 

BEGIN  ELSET  :=  NIL;  SIZE  :=  0;  FORM  :=  POWER  END; 
IF  SY  =  RBRACK  then 
BEGIN 

WITH  GATTR  do 

BEGIN  TYPTR  :=  LSP;  KIND  :=  CST  END; 
INSYMBOL 
END 
ELSE 
BEGIN 

REPEAT  EXPRESSION(FSYS  +  CC0MMA,RBRACK»C0L0N3) ; 
IF  GATTR. TYPTR  <>  NIL  THEN 

IF  GATTR. TYPTR'^. FORM  <>  SCALAR  THEN 

BEGIN  ERR0R(136)«  GATTR. TYPTR  !=  NIL  END 
ELSE 

IF  COMPTYPES(LSP'*. ELSET, GATTR, TYPTR)  THEN 
BEGIN  ALLCONST  !=  FALSE;  LOP  :=  23{*SGS*)J 
IF  (GATTR. KIND  =  CST)  AND 

(GATTR, CVAL.IVAL  <=  127)  THEN 
BEGIN  ALLCONST  :=  TRUE; 

LOWVAL  :=  GATTR, CVAL.IVAL; 
HIGHVAL  :=  LOWVAL 
END; 

Lie  :=  ics-load; 

IF  SY  =  COLON  THEN 

BEGIN  INSYMBOL;  LOP  :=  20(*SRS*); 
EXPRESSI0N(FSYS  +  CCOMMA .RBRACK]) ; 
IF  COMPTYPES(LSP'^. ELSET, GATTR. TYPTR)  THEN 
ELSE 

BEGIN  ERR0R{137);  GATTR. TYPTR:=NIL  END; 
IF  ALLCONST  THEN 

IF  (GATTR. KIND  =  CST)  AND 


411 


412 


3^+77 

13 

45:5 

29 

5^7Q 

13 

45:6 

35 

3'*79 

13 

45:5 

35 

3^+80 

13 

45:6 

40 

5481 

13 

45:4 

45 

3482 

li 

45:3 

47 

3483 

13 

45:2 

49 

3434 

13 

45:3 

52 

3485 

13 

45:4 

55 

3486 

13 

45:3 

65 

3487 

13 

45:2 

70 

3488 

13 

45:3 

72 

3489 

13 

45:4 

75 

3490 

13 

45:4 

79 

3491 

13 

45:3 

83 

3492 

13 

45:2 

86 

3493 

13 

45:2 

91 

3494 

13 

45:1 

91 

3495 

13 

45:0 

94 

3496 

13 

45:8 

02 

3497 

13 

45:8 

07 

3498 

13 

45:7 

11 

3499 

13 

45:7 

17 

3500 

13 

45:6 

28 

3501 

13 

45:5 

31 

3502 

13 

45:6 

34 

3503 

13 

45:7 

34 

3504 

13 

45:8 

44 

3505 

13 

45:9 

44 

3506 

13 

45:9 

57 

3507 

13 

45:9 

61 

3508 

13 

45:9 

65 

3509 

13 

45:9 

68 

3510 

13 

45:8 

71 

3511 

13 

45:7 

73 

3512 

13 

45:6 

73 

3513 

13 

45:5 

76 

3514 

13 

45:6 

78 

3515 

13 

45:7 

78 

3516 

13 

45:7 

91 

3517 

13 

45:7 

95 

(GATTH.CVAL.IVAL  <=  127)  THEN 
HI6HVAL  :=  GATTR.CVAL.IVAL 

ELSE 

BEGIN  LOAD;  ALLCONST  :=  FALSE  END 
ELSE  LOAD 
END; 
IF  ALLCONST  THEN 

begi[ni  ic  :=  Lie;    (*forget  first  const*) 

CSTPART  :=  CSTPART  +  CLOWVAL. .HIGHVAL3 

END 
ELSE 

begin  geno(lqp) ; 
if  varpart  then  geno (28{ ♦uni* ) ) 
else  varpart  :=  true 
end; 
lsp^.elset  :=  gattr.typtr; 
gattr.typtr  1=  lsp 

END 
ELSE  ERROR (137); 

TEST  :=  SY  <>  comma; 

IF  NOT  TEST  THEN  INSYMBOL 
UNTIL  TEST? 

IF  SY  =  RBRACK  THEN  INSYMBOL  ELSE  ERR0R(12) 
END; 
IF  VARPART  THEN 
BEGIN 

IF  CSTPART  Oil    THEN 
BEGIN 

SCONST'^.PVAL  :=  CSTPART; 
SCONST'^.CCLASS  1=  PSET; 
GATTR.CVAL.VALP  :=  SCONST; 
GATTR.KIND  :=  CST; 
LOAD;  GEN0(28(*UNI*)) 
END; 
GATTR.KIND  1=  EXPR 
END 
ELSE 
BEGIN 

SCONST''. PVAL  :=  CSTPART; 
SCONST'". CCLASS  :=  PSET; 
GATTR.CVAL.VALP  :=  SCONST; 


3513 

13 

*+b:7 

99 

35iy 

15 

^b'.a 

99 

3  520 

13 

'+b;4 

02 

i52l 

13 

'fsrs 

U2 

3522 

13 

^515 

10 

3523 

13 

^+5:1 

2j 

352'! 

13 

45:2 

10 

3525 

13 

45:0 

10 

3526 

13 

'fsro 

72 

3527 

13 

'^'+:o 

0 

3528 

13 

44:1 

0 

3529 

13 

•^^ii 

20 

3530 

13 

'+4:2 

25 

3531 

13 

'+'^:3 

37 

3532 

13 

'+'+:3 

62 

3533 

13 

'+«+:'+ 

71 

SSSH 

13 

ftf  :4 

71 

3535 

13 

'+'+:6 

83 

3536 

13 

'+'+:6 

89 

3537 

13 

tf+lS 

93 

3538 

13 

'*^:7 

97 

3539 

13 

'+'+:7 

01 

SSi+O 

13 

'4'+:7 

09 

3541 

13 

'+1:3 

13 

3542 

13 

'41:8 

17 

3513 

13 

11:9 

21 

354'+ 

13 

11:8 

30 

3545 

13 

11:9 

32 

35^6 

13 

11:9 

36 

Z5^7 

13 

itro 

16 

ss^+a 

13 

11:9 

17 

sst^g 

13 

14:5 

60 

3550 

13 

11:1 

62 

3551 

13 

11:6 

67 

3552 

13 

11:6 

71 

3553 

13 

41: 6 

79 

3551 

13 

11:5 

92 

3555 

13 

11:1 

91 

3556 

13 

11:6 

98 

3557 

13 

11:6 

01 

3558 

13 

11:6 

08 

GATTR.KIrJC     :=    CST 
LND 
t.  H  [.,. 
END    (*caSE*)     ; 
IF    NOT    (SY    IN    FSYS)     THEN 

BEGIN    ERR0R(6);     SKIP(FSYS    +    FACBEGSYS)     END 
END    (*WHILE*) 
Li'jD    (♦FACTOR*)     ; 

BEGIN  (♦TERM*) 

paCTOR(FSYS  +  CMULCPJ); 
WHILE  SY  =  MULUP  DO 

BEGIN  LOAD;  LATTR  :=  SATTR;  LOP  :=  OP; 
INSYMBOL;  FACT0R(FSYS  +  CMULOPJ);  LOAD; 

IF  (LATTR. TYPTR  <>  NIL)  AND  (GATTR.TYPTR  <>  NIL)  THEN 
CASE  LOP  OF 
(♦**)      MUL:   BEGIN  FL0ATIT(LATTR. TYPTR. FALSE);  STRETCHIT( LATTR. TYPTR ) ; 

IF  (LATTR. TYPTR  =  INTPTR)  AND  (GATTR.TYPTR  =  INTPTR) 

THEN  GEN0(15(*MPI*) ) 
ELSE 

IF  (LATTR, TYPTR  =  REALPTR)  AND 

(GATTR.TYPTR  =  REALPTR)  THEN  GENO ( 16( *MPR») ) 
ELSE 

IF  (GATTR.TYPTR'*, FORM  =  LONGINT)  AND 
(LATTR. TYPTR'". FORM  =  LONGINT)  THEN 
BEGIN  GENLDC(8(*DMP*) ) ;  GENNR (DECOPS )  END 
ELSE 

IF  (LATTR. TYPTR^. FORM  =  POWER) 

AND  COMPTYPES(LATTR, TYPTR, GATTR.TYPTR)  THEN 
GEN0(12(*INT*) ) 

ELSE  BEGIN  ERR0R(134);  GATTR.TYPTR: =NIL  END 
END; 
(*/♦)      RDIV:  BEGIN  FLOATIT{LATTR.TYPTR,TRUE); 

IF  (LATTR, TYPTR  =  REALPTR)  AND 

(GATTR, TYPTR  =  REALPTR)  THEN  GENO ( 7 (♦DVR*) ) 
ELSE  BEGIN  ERR0R(l34);  GATTR.TYPTR  :=  NIL  END 
END; 
(*DIV*)    IDIV:  BEGIN  STRETCHIT(LATTR. TYPTR ) ; 

IF  (LATTR, TYPTR  =  INTPTR)  AND 

(GATTR.TYPTR  =  INTPTR)  THEN  GENO {6( *DVI* ) ) 
ELSE 
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'14 


•tx- 


3559 

13 

'+'+:7 

12 

3  560 

13 

H'+:  7 

16 

3561 

13 

'+'+:o 

23 

3562 

15 

'+4: 7 

29 

3563 

13 

'+'+:5 

4  0 

356H 

13 

'+4:'+ 

4P 

3565 

13 
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if  (lattr.typtr'^.form  =  longint)  and 
(gattr.typtr'^.fori^;  =  lqngint)  then 
begin  genldc(10(*ddv*)  )  ;  ge^jnr  (  decops  )  end 
Else  begin  error(134);  gattr.typtr  :=  nil  end 

END; 

(*>ioo*)   iMOo:  IF  (lattr.typtr  =  intptr)  and 

(GATTR.TYPTR  =  INTPTR)  THEN  6EN0 (14 ( *MOD*  )  ) 
ELSE  BEGIN  Ei^^ROR  ( 134 )  ;  GATTR.TYPTR  :=  NIL  END; 
(♦AND*)    AND0P:IF  (LATTR.TYPTR  =  BOOLPTR)  AND 

(GATTR.TYPTR  =  BOOLPTR)  THEN  GENO ( 4 ( *AND* ) ) 
ELSE  BEGIN  ERR0R(134);  GATTR.TYPTR  :=  NIL  END 
END  (*CASE*) 
ELSE  GATTR.TYPTR  :=  NIL 
END  (*WHILE*) 
END  (*TERM*)  ; 

BEGIN  (*SIMPLEEXPRESSI0N*) 

SIGNED  :=  false; 

IF  (SY  =  ADDOP)  AND  (OP  IN  CPLUS» MINUS3)  THEN 

3EGIN  SIGNED  :=  OP  =  MINUS;  INSYMBOL  END; 
TERM(FSYS  +  CADDOP]) ; 
IF  SIGNED  THEN 
3EGIN  LOAD; 

IF  GATTR.TYPTR  =  INTPTR  THEN  GENO ( 17 ( *NGI* ) ) 
ELSE 

IF  GATTR.TYPTR  =  REALPTR  THEN  GENO ( 18 ( *NGR* ) ) 
ELSE 

IF  GATTR.TYPTR'*. FORM  =  LONGINT  THEN 

BEGIN  6ENLDC(6(*DNG*) ) ;  GENNR ( DECOPS )  END 
ELSE  BEGIN  ERR0R(134);  GATTR.TYPTR  :=  NIL  END 
END; 
WHILE  SY  =  ADOOP  DO 

3EGIN  LOAD;  LATTR  :=  GATTR;  LOP  :=  OP; 
INSYMBOL;  tERM(FSYS  +  CADDOPD);  LOAD; 

IF  (LATTR.TYPTR  <>  NIL)  AND  (GATTR.TYPTR  <>  NIL)  THEN 
CASE  LOP  OF 

(*+*)     PLUS: 

BEGIN  FL0ATIT(LATTR. TYPTR, FALSE) ;  STRETCHIT ( LATTR .TYPTR ) ; 
IF  (LATTR.TYPTR  =  INTPTR ) AND ( GATTR .TYPTR  =  INTPTR)  THEN 

GEN0(2(*ADI*) ) 
ELSE 


3600 

3631 

3602 

3603 

360'+ 

3605 

3606 

3607 

3608 

3609 

3610 

3611 

3612 

3613 

361*+ 

3615 

3616 

3617 

3618 

3619 

3620 

3621 

3622 

3623 

362*f 

3625 

3626 

3627 

3628 

5629 

3630 

3631 

3632 

3633 

363^ 

3635 

3636 

3637 

3638 

3639 

36^0 


13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 


^+5 

43 

43 

43 

43 

43 

43 

43:9 

43:5 

43:0 

43;9 

43:5 

43:4 

43:5 

43:6 

43:7 
43:6 
43:7 
43:7 
43:7 

43:8 
43:8 

43:9 

43:a 

43:9 

43:9 

43:o 

43:9 

43:5 

43:^ 

43:5 

43:& 

43:5 

43:4 

43:3 

'+3:2 

43:0 

43:0 

46  :d 

46:d 

46:o 


67 
78 
79 
83 
87 
94 
00 

C6 

16 

17 

30 

32 

32 

41 

50 

51 

55 

63 

67 

71 

75 

82 

88 

90 

94 

04 

05 

18 

20 

20 

31 

32 

45 

60 

62 

65 

90 
1 
3 
0 


''gENo[I?:IJrI),'  REALPTR,AND(GATTR.TYPTR  =  REALPTR,  THEN 
ELSE 

IF  (GATTR.TYPTR'^.FORM  =  LONGIiMT)  AND 
(LATTR.TYPTR-.FORM  =  LONGINT)  THEN 
BEGIN  GENLDC(2(*DAD*));  GENNR (DECOPS)  END 

t  W  O  L_ 

IF  (LATTR.TYPTR'^.FORM  =  POWER) 

'-^'in,o  =  ^''^^^^^"-'^^^f^-"^YP^R'GATTR.TYPTR)  THEN 
toEN0(28{*UNI*) ) 

END;     ^''^^  ^^^^^^  ER'^0R(134);  GaTTR.TYPTR  :=  NIL  END 

<*-*)      MINUS: 

'"F^[A??R'Tip?p''•y^^?p5^^'''^'  '  STRETCHIT(LATTR.TYPTR,  , 

GEnSIJ^IsBI*,!  '"'"''^  ''°  (GATTR.TYPTR  =  INTPTR)  THEN 
ELSE 

ELSE 

IF  (GATTR.TYPTR'*. FORM  =  LONGINT)  AND 
(LATTR.TYPTR^.FORM  =  LONGINT)  THEN 
BEGIN  GENLDC(4{*DSB*));  GENNR (DECOPS)  END 
LLSu 

IF  (LATTR.TYPTR'^.FORM  =  POWER) 

GENo?5?°aiF^'n'''''''-''''''^'^^^'^-^^^^^  ^^^^ 

END?     ^^^^  ^^^^^    ERR0R(134);  GATTR.TYPTR  :=  NIL  END 

(*0R*)    drop: 

'%EN5a3;Il0R:,;  '°°'''''  '^^^  (GATTR.TYPTR  =  BOOLPTR,  THEN 
END  (*?ASE*?^''  ERR0R(134)5  GATTR.TYPTR  :=  NIL  END 

ELSE  GATTR.TYPTR  :=  NIL 
END  (*WHILE*) 
END  (*SIMPLEEXPRESSI0N*)  ; 

PROCEDURE  MAKEPA(VAR  STRGFSP:  STP;  PaFSP'  STP): 

VAr  LMIN.LMAX:  INTEGER; 
BEGIN 
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46 
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19; 
19; 
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IF    PAFSP'^.IIMXTYPt    <>    NIL    THEN 

3lGIN    GET30Ur.jDiJ(PAFSP'^.INXTYPE.LMINiLMAX) 
IF    LMAX-L^J!ir^  +  l    <>    STRGFSP" . ^^AXLENG    THEN 
END; 
STRGFSP     :=    PAFSP 
L[\1D    C+MAKEPA*)     ; 


ERR0R(129) 


begin  (#£xpre 
simpleexpre 

IF  Sy  =  REL 
BEGIN 

USTRING 

IF  GATT 
IF  GA 
ELSE 

lattr  : 

INSYMBO 
GSTRING 

IF  GATT 

IF  GA 

ELSE 

IF  (LAT 

IF  LO 

IF 

I 

E 
ELS 

ELSE 
BEG 
I 


I 


SSION*) 
SSION(FSYS 

OP  THEN 


+  CRELOPD) 


:=  (GATTR.KIND  =  CST)  AND 

(STRGTYPE(GATTR.TYPTR)  OR  (GATTR.TYPTR  =  CHARPTR)); 
R.TYPTR  <>  NIL  THEN 

TTR.TyPTR'^.FORM  <=  POWER  THEN  LOAD 
LOADADDRESS; 

=  GATTRJ  LOP  :=  0P5  LSTRSIC  ;=  STRGCSTIC; 
L;  SIMPLEExPRESSION(FSYS) ; 

:r  (GATTR.KIND  =  CST)  AND 

(STRgTYPE(GATTR.TYPTR)  OR  (GATTR.TYPTR  =  CHARPTR)); 
R.TYPTR  <>  NIL  THEN 

TTR.TyPTR'^.FORM  <=  POWER  THEN  LOAD 
LOADADDRESS; 

TR.TYPTR  <>  NIL)  AND  (GATTR.TYPTR  <>  NIL)  THEN 
P  =  INOP  THEN 

GATTR.TYPTR**. FORM  =  POWER  THEN 
F  COMPTYPES(LATTR.TYPTR»GATTR,TYPTR'*.ELSET)  THEN 

GEN0(11(*INN*)  ) 
LSE  BEGIN  ERR0R{129);  GATTR.TYPTR  :=  NIL  END 
E  BEGIN  ERROR(130);  GATTR.TYPTR  :=  NIL  END 


IN 

F  LATT 

BEGIN 

F  LSTR 

BEGIN 

IF 

I 


R.TYPTR  <>  GATTR.TYPTR  THEN 

FLOATlT(LATTR.TYPTR»FALSE) ; 
ING  THEN 


STRETCHIT(LATTR,TYPTR)  END5 


PAOFCHAR(GATTR.TYPTR)  THEN 

F  NOT  GATTR.TYPTR'^.AISSTRNG  THEN 

BEGIN  STRGTOPA(LSTRGIC) ; 

MAKEPA( LATTR. TYPTR« GATTR.TYPTR) 

END 
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THEN 


Ei\lD 
ELSE 

IF  GSTHING  THEN 
BEGIN 

IF  PAOFCHAR(LATTR.TYPTR)  THEN 
IF  'MOT  LATTR.TYPTR-.AISSTRNG 
BEGIN  STRGTOPA(STRGCSTIC) ; 

MAKEPA(GATTR.TyPTR»LATTR.TYPTR) 

END; 

Ei\jd; 

IF  (LSTRING  AND  STRGTYPE ( GATTR. TYPTR ) )  OR 

(GSTRING  AND  STRGTYPE<LATTR. TYPTR ) )  THEN  GOTO  1; 
IF  CO^^PTYPES(LATTR. TYPTR, GATTR. TYPTR)  THEN 

''«^.'^J^?.;t%p'?JI!pJ«^S^SP-"^^=  '"^"^"  ""  ^ONG  INTE3ERS.. 

scalar: 

IF  LATTR, TYPTR  =  ReALPTR  THEN  TYPIND  :=  1 
ELSE 

IF  LATTR. TYPTR  =  BOOLPTR  THEN  TYPIND  :=  3 
ELSE  TYPIND  :=  0; 
POINTER: 
BEGIN 

TYpir  •-  '^'-^°^'^^°P'ST0P.6E0P3  THEN  ERR0R(131); 

END; 
LONGINT:  TYPIND  :=  7; 
POWER: 

BEGIN 

IF  LOP  IN  CLT0P,GT0PD  THEN  ERR0R{132); 
TYPIND  :=  4 
END; 

arrays: 

BEGIN 

TYPIND  :=  6; 

IF  PAOFCHARtLATTR, TYPTR)  THEN 
IF  LATTR, TYPTR-^.AISSTRNG  THEN 
IJ  TYPIND  :=  2 

ELSE 

BEGIN  TYPIND  :=  5; 

IF  LATTR. TYPTR-, INXTYPE  <>  NIL  THEN 
BEGIN 
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BOUNDS  (LATTR.TYPTR'".INXTYPE«LMI(\J»LKAX)  ! 
ZE  :=  LMAX  -  LMIN  +  1 


LOP  IN  CLTOPtLEOPtGTOPiGEOP:]  THEN  ERR0R{131) 


IN  CLT0P»LE0P»GT0P«GE0P3  THEN  ERR0R(13l)! 

:=  6 


GET 
LSI 

END 
END 
ELSE 
IF 
END; 

records: 

BEGIN 

IF  LOP 

TYPING 
END; 

files: 

BEGIN  ERR0R(133);  TYPING  :=  0  END 

end; 

if  typind  =  7  then 

BEGIN  GENLDC(0RD(L0P)) ;  GENLDC(16{*DCMP*)) ; 

GENNR(DECOPS) 
END 
ELSE 

CASE  LOP  OF 

LTOP:  GEN2(53(* 


LEOP: 
GTOP: 
GEOP: 
NEOP: 
EQOP: 
END 
END 

else  err0r(129) 
end; 
gattr.typtr  :=  boolptr; 

END  {♦SY  =  RELOP*) 
END  (*EXPRESSION*)  ; 


LES*), TYPING, LSIZE); 
GEN2(52(*LEQ*).TYPIND»LSIZE) J 
GEN2 ( 49 (*GRT*), TYPIND tLSIZE) ; 
GEN2( 48 (*GEQ»)» TYPING tLSIZE) ; 
GEN2 ( 55 (♦NEQ*)» TYPIND tLSIZE) ; 
GEN2(47(*EQU*) iTYPlNDtLSIZE) 


GATTR.KIND  :=  EXPR 


(*$I 
(♦$1 

(* 
(* 


«5:30DYPART.D.TEXT*) 
»5:30DYPART,E.TEXT*) 


COPYRIGHT  (C) 
UNIVERSITY  OF 


1979,  REGENTS  OF  THE 
CALIFORNIA,  SAN  DIEGO 


*) 
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PHOCEDURL  STATE)^E!-JT(FSYS:  SET9FSYS); 
LABEL  1; 

VAR  ^cp:  ctp;  ttop:  disphange;  llp:  labelp;  heap:  "integer; 

PROCEDURE  AS$IGnmENT(FCP:  CTP); 

beg"^  sEu'Ec^oRlF^^s^r^^^^i^^r^tpc";-'""'"''  ^mn.^-..:   integer, 

IF  SY  =  BECOMES  THEN 

3EGIN  LMAX  :=  0;  CSTRING  :=  FALSE; 
IF  GATTR.TyPTR  0  NIL  THEN 

^^iASIJoHESS;^"  '  ^''°'''^''  °'  (GATTR.TYPTR-. FORM  >  POWER)  THEN 

PAONLEFT  :=  PAOFCHAR(GATTR.TYPTR); 

LATTR  :=  GATTR; 

INSYMBOL;  EXPRESSION(FSYS); 

IF  GATTR, KIND  =  GST  THEN 

ir'II?^^?T;;T^'jr^k''mN=  '""'""  °'  STRSTYPE.GATTR.TYPTRM 
IF  GATTR, TYPTR-^. FORM  <=  POWER  THEN  LOAD 
ELSE  LOADADDRESS; 

IF  (LATTR. TYPTR  <>  NIL)  AND  (GATTR.TYPTR  <>  NIL)  THEN 
BEGIN  ■■•■-'I 

IF  GATTR.TYPTR  =  INTPTR  THEN 

IF  COMPTYPESCREALPTR, LATTR. TYPTR)  THEN 

BEGIN  GEN0(10(*FLT»));  GATTR.TYPTR  •=  REALPTR  ENDJ 
IF  COMPTYPES(LONGINTPTR, LATTR. TYPTR)  THEN  ''^'^^^^^    ^^^^ 
BEGIN 

IF  GATTR.TYPTR  =  INTPTR  THEN 

BEGIN  GENLDC(18(*0CVT*))|  GENNR (DECOPS) ; 

GATTR.TYPTR  :=  LONGINTPTR 
END; 

IF  GATTR. TYPTR". FORM  <>  LONGINT  THEN 
END;^^*^^"^  ^'^"°'^*^^^"  GATTR.TYPTR  :=  LONGINTPTR  END 
IF  PAONLEFT  THEN 

IF  LATTR. TYPTR". AISSTRNG  THEN 

IF  CSTRING  AND  (GATTR.TYPTR  =  CHARPTR)  THEN 

GATTR.TYPTR  :=  STR6PTR 
ELSE 
ELSE 

IF  LATTR. TYPTR". INXTYPE  <>  NIL  THEN 
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4817 

36 

382^ 

13 

48:6 

90 

3825 

13 

48:8 

90 

3826 

13 

48:8 

95 

3827 

13 

48:7 

97 

3828 

13 

48:6 

01 

3829 

13 

48:6 

01 

3830 

13 

48:6 

07 

3831 

13 

48:8 

07 

3832 

13 

48:8 

11 

3833 

13 

48:8 

14 

3831 

13 

48:8 

17 

3835 

13 

48:7 

19 

3836 

13 

48:6 

23 

3837 

13 

48:8 

26 

3838 

13 

48:9 

30 

3839 

13 

48:8 

34 

3810 

13 

48:7 

44 

3811 

13 

48:6 

35 

3842 

13 

48:6 

62 

3843 

13 

48:6 

65 

3844 

13 

48:5 

94 

BEbIN    GETBOiJiNDS(LATTR.TYPTR'*.INXTYPE,LMIN,Lf'AX)  ; 
LMAX     :=    L^AX    -    LMIN    +    1; 

IF  CSTRING  AND  (GATTR.TYPTR  <>  CHARPTR)  THEN 
BEGIN  STRGTOPAiSTRGCSTiC) ; 

IF  LMAX  <>  GATTR.TYPTR'*, MAXLEMG  THEN  ERROR  (  1 
GATTR.TYPTR  :=  LATTR.TYPTR 
END 
END 
ELSE  GATTR.TYPTR  :=  LATTR.TYPTR; 
IF  COMPTYPES(LATTR.TYPTR. GATTR.TYPTR)  THEN 
CASE  LATTR.TYPTR'^.FORM  OF 
subrange:  BEGIN 

IF  RANGECHECK  THEN 
BEGIN 

GENLDC(LATTR.TYPTR*.MIN.IVAL) ; 
GENLDC(LATTR.TYPTR*,MAX.IVAL) ; 
GEN0(8(*CHK*)) 
END; 
STORE(LATTR) 
END; 
POWER:     BEGIN 

GEN1{32(*ADJ*).LATTR.TYPTR'*.SIZE); 

store(lattr) 

end; 


430 


29) 


SCALAR, 

pointer: 
longint: 


arrays: 


records: 
files: 

END 
ELSE  ERR0R(i29) 


store(LATTR); 

BEGIN 

GENLDCtLATTR.TYPTR'^.SIZE)  ; 
GENLDC(0{*DAJ*) ) ; 
GENNR(DECOPS); 
STORE(LATTR) 
END; 

IF  paonleft  then 

IF  LATTR.TYPTR^, AISSTRNG  THEN 

GENX(42(*SAS*),LATTR,TYPTR^,MAXLENG) 

ELSE  GEN1(40(*MOV*),(LWAX+1)  DIV  2) 
ELSE  GEN1{40(*MOV*)  , LATTR.TYPTR''. SIZE)  ; 
GEN1(40(*MOV*),LATTR.TYPTR''.SIZE)  ; 
ERR0R(146) 


56^5 

15 

43:4 

99 

satffe 

13 

48:? 

02 

.^atf? 

13 

48:i 

32 

3848 

13 

43  :o 

05 

ia'^3 

13 

48:o 

26 

3350 

15 

49  :d 

1 

3851 

13 

49  :q 

1 

3852 

13 

49  :o 

0 

3853 

13 

49:i 

0 

3851 

13 

49:i 

9 

3855 

13 

49:2 

14 

3856 

13 

49:3 

14 

3857 

13 

49:3 

20 

3858 

13 

49:3 

37 

3859 

13 

49:3 

45 

3860 

13 

49:4 

53 

3861 

13 

49:5 

56 

3862 

X3 

49:6 

63 

3863 

13 

49:7 

66 

3864 

13 

49:6 

69 

3865 

13 

49:5 

71 

3866 

13 

49:3 

79 

3867 

13 

49:3 

89 

3868 

13 

49:2 

89 

3869 

13 

49:1 

92 

3870 

13 

49:0 

95 

3871 

13 

49:0 

14 

3872 

13 

5o:d 

1 

3873 

13 

5o;o 

0 

3874 

13 

5o:i 

0 

3875 

13 

50:2 

0 

3876 

13 

50:2 

13 

3877 

13 

50:2 

25 

3878 

13 

50:2 

30 

3879 

13 

5o:i 

34 

3880 

13 

5o:i 

40 

3881 

13 

50  :o 

51 

3882 

13 

5o:o 

70 

3883 

13 

5i:d 

1 

3884 

13 

5i:d 

1 

3885 

13 

5i:q 

0 

ElfjO    (*SY    =    BECOMES*) 
ELSE    ERROR(bi) 
EWO    {^cASSIG^JMENT*)     ; 

PROCEDURE  GOTOSTaTEMENT; 

3EGi^  ^^^'   ^^^^^^'   "^ound:  boolean;  ttop:  disprange; 

IF    fviOT    GOTOOK    THEN    ERR0R(6); 
IF    SY    =    INTCONST    THEN 
BEGIN 

FOUND  :=  FALSE;  TTOP  :=  TOP; 

WHILE  DISPLAYCTT0P3. OCCUR  <>  BLCK  DO  TTOP  :=  TTOP  -  i; 
LLP  :=  DISPLAYCTT0P3.FLABEL; 
WHILE  {LLP  <>  NIL)  AND  NOT  FOUND  DO 
WITH  LLP'^  DO 

IF  LABVAL  =  VAL.IVAL  THEN 
BEGIN  FOUND  :=  TRUE; 

GENJMP{57(*UJP*) .CODELBP) 
END 

ELSE  LLP  :=  NEXTLAB; 
IF  NOT  FOUND  THEN  ERR0R(167); 
INSYMBOL 
END 
ELSE  ERRORdS) 
END  (*GOTOSTATEMENT*)  ; 

PROCEDURE  COMPOUNDSTATEMENT; 
BZGlH 
REPEAT 

REPEAT  STATEMENT(FSYS  +  CSEMICOLON.ENDSYT) 

UNTIL  NOT  (SY  IN  STATBESSYS); 

TEST  :=  SY  <>  SEMICOLON; 

IF  NOT  TEST  THEN  INSYMBOL 
UNTIL  TEST; 

IF  SY  =  ENDSY  THEN  INSYMBOL  ELSE  ERR0R<13) 
END  (♦COMPOUNDSTATLMENET*)  ;         r^t^ur^tioi 

PROCEDURE  IFSTATEMENT; 

3EG?N  '-"^^'^"^2:  LBP;  Lie:  INTEGER,  CONDCOmPILE,NOTHENCLAUSE:  BOOLEAN; 
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3886 

13 

bi:i 

0 

.i9b7 

13 

Di:  1 

6 
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13 

5i:i 

13 

3999 

13 

bi:2 

23 
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13 

5i:3 

29 
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13 
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32 

3892 

13 
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13 
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13 

bi:i 
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13 

5i:2 

43 

3896 

13 

5i;i 

50 
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13 
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64 

3898 

13 

5i:i 

79 
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13 

5i:2 

82 
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13 
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85 
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13 
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93 
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13 
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13 

51:3 

98 
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13 

51:4 

02 

3905 

13 

51:3 

13 
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13 

5i:3 

26 

3907 

13 

51:4 

29 

3908 

13 

51:5 

29 

3909 

13 

51:4 

33 

3910 

13 

51:3 

36 

3911 

13 

51:2 

39 

3912 

13 

5i:i 

41 

3913 

13 

51:2 

43 

391'+ 

13 

5i:o 

48 

3915 

13 

51:0 

62 

3916 

13 

52:d 

3917 

13 

52:0 

3918 

13 

52:d 

3919 

13 

52:d 

3920 

13 

52:d 

3921 

13 

52:d 

3922 

13 

52:d 

3923 

13 

52:d 

5924 

13 

52:d 

3925 

13 

52:0 

8 

3926 

13 

52:0 

0 

COf'jrCOMPILE:     :=    FALSE.; 

expRE:ssioN(FSYs  +  cthensy:); 

IF     (GATTFUKirJO    =    CST)     THEN 

IF     (GATTR.TYPTK    =    BOOlPTR)     THEN 
BEGIiJ    CONDCOMPILE    :=    TRUE; 

iNlOTHElMCLAUSE    :=    NOT    DDD  (  GATTR  ,CVAL  .  I VAL)  ; 

Lie  :=  IC 

ENO; 
IF  NOT  CONDCOMPILE  THEN 

BEGIN  GENLA3EL(LCIX1) ;  G£NFJP(LCIX1)  END; 
IF  SY  =  THENSY  THEN  INSYM30L  ELSE  ERR0R(52); 
STaTEMENT(FSYS  +  CELSESY3); 
IF  CONDCOMPILE  THEN 

IF  NOTHENCLAUSE  THEN  IC  :=  LIC 

ELSE  LIC  :=  ic; 

IF  SY  =  ELSESY  THEN 
3EGIN 

if  not  condcompile  then 

begin  genlabel(lcix2) ;  genjmp (57 ( *ujp* ) .lcix2 ) ;  putlabel{ lcixl )  end 
insymbol;  statementcfsys) ; 
if  condcompile  then 

BEGIN 

IF  NOT  NOTHENCLAUSE  THEN  IC  :=  LIC 
END 
ELSE  PUTLABEL{LCIX2) 

END 

ELSE 

IF  NOT  CONDCOMPILE  THEN  PUTLABEL (LCIXl ) 

END  (*IFSTATEMENT*)  ; 

PROCEDURE  CASESTATEMENT; 
LA3EL  1; 

TYPE  CIP  =  '^CASEINFO; 
CASEINFO  =  RECORD 

next:  CIP; 
CSSTART:  INTEGER; 
CSLAB:  INTEGER 
END; 

yp^R   LSPtLSPi:  sTP;  FSTPTRtLPTi.LPT2»LPT3:  CIP;  lval:  valu; 

LADDRf  LClx:  LBP;  NULSTMT,  LMIN,  LMAX:  INTEGER; 
BEGI^J  EXPRESSION(FSYS  +  C  OFSY  t  COMMA  »  COLON  3  )  ; 
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15 

52:i 

lb 

5928 

15 

52:i 

25 

5923 

13 

52:i 

2  8 

5930 

13 

52:2 

53 

5931 

15 

02:5 

44 

3932 

13 

32:i 

53 

3933 

13 

52:i 

67 

393^1 

13 

52:i 

74 

3935 

13 

52:2 

74 

393S 

13 

52:2 

77 

5937 

15 

52:3 

95 

3938 

13 

52:4 

00 

3939 

13 

52:5 

09 

39fO 

13 

52:6 

15 

39fl 

13 

52:7 

20 

39^2 

13 

52:3 

23 

39tf3 

13 

52:9 

23 

3944 

13 

52:0 

29 

3915 

13 

52:1 

41 

3946 

13 

52:0 

43 

3947 

13 

52:9 

43 

3943 

13 

52;8 

46 

3949 

13 

52:6 

52 

3950 

13 

52:6 

57 

3951 

13 

52:7 

60 

3952 

13 

52:8 

68 

3953 

13 

52:7 

71 

3954 

13 

52:6 

73 

3955 

13 

52:6 

78 

3956 

13 

52:5 

84 

3957 

13 

52:4 

86 

3958 

13 

52:3 

94 

3959 

13 

52:3 

99 

3960 

13 

52:2 

03 

3961 

13 

52:2 

09 

3962 

13 

52:2 

23 

3963 

13 

52:2 

34 

3964 

13 

52:2 

46 

3965 

13 

52:3 

51 

3966 

13 

52:2 

55 

3967 

13 

52:2 

60 

load;  '9Enlabel(LCIx)  ;  gemJ:'ip(57(*ujp*)  ,lcix)  ; 
LSp  :=  gattr.typtr; 

IF  LSP  0  rjlL  THEN 

IF  (LSP-^.FORm  <>  SCALAR)  OR  (LSP  =  REALPTR)  THEN 
BEGIN  ERR0R(144);  LSP  :=  NIL  END; 
IF  SY  =  OFSY  THEN  INSYMBOL  ELSE  ERR0R(8); 
FSTPTR  :=  NIL;  GENLABEL(LADDR) ; 
REPEAT 

LPT3  :=  NIL; 

REPEAT  CONSTaNT(FSYS  +  CCOMMA » C0L0N3 » LSPl » LVAD ; 
IF  LSP  0  NIL  THEN 

IF  CGMPTYPES(LSP,LSP1)  THEN 

BEGIN  LPTl  :=  FSTPTR;  LPT2  :=  NIL; 
WHILE  LPTl  0  NIL  DO 
WITH  LPTl''  DO 
BEGIN 

IF  CSLAB  <=  LVAL.IVAL  THEN 

BEGIN  IF  CSLAB  =  LVAL.IVAL  THEN  ERR0R(156)J 

GOTO  1 
END; 
LPT2  :=  LPTi;  LPTl  :=  NEXT 

end; 
NEW(LPT3); 

with  lpts**  do 

begin  next  :=  lptl;  cslab  :=  lval.ival; 
csstart  :=  ic 

end; 
if  lpt2  =  nil  then  fstptr  1=  lpt3 
else  lpt2'*. next  :=  lpt3 

END 
ELSE  ERR0R(147) ; 

TEST  :=  SY  0  COMMA; 

IF  NOT  TEST  THEN  INSYMBOL 
UNTIL  TEST; 

IF  SY  =  COLON  THEN  INSYVIBOL  ELSE  ERR0R(5); 
REPEAT  STATEMENTCFSYS  +  CSEMIC0L0N3) 
UNTIL  NOT  (SY  IN  STATBEGSYS); 
IF  LPT3  0  NIL  THEN 

GENJMP(57(*UJP*) tLADDR) ; 
TEST  :=  SY  <>  SEMICOLON; 
IF  NOT  TEST  THEN  INSYMBOL 
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13 

52:6 

54 

3987 

13 

52:6 

61 

5988 
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70 

3990 
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4008 
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UNTIL  TEST  OR  (ST  =  ENDSY); 

PUTLAS£L(LCIX) ; 

IF    FSTPTR    0    rJlL    THEN 

3EGIi^    L?^AX     :=    t-STPTR'".CSLA6; 

LPTl  ;=  FSTPTR;  FSTPTR  ;=  NIL; 

REPEAT  LPT2  :=  LPTl'^.MEXT;  LPTl'^.NEXT  :=  FSTPTR; 

FSTPTR  :r  LPTi;  LPTl  :=  LPT2 
UNTIL  LPTl  =  nil; 
LMIN  :=  FSTPTR^, CSLAB; 
GEN0(44(*XJP*)  )  ; 
GENWORD(LMIN) ;  GEMWORD ( LMAX ) ; 
NULSTMT  :=  ic; 
GENJMP(57(*UJP*) iLADDR) ; 
REPEAT 

WITH  FSTPTR*^  DO 
BEGIN 

WHILE  CSLAB  >  LMIN  DO 

BEGIN  GENWORD(IC-NULSTMT) ;  LMIN  1=  LMIN  +  1  END* 
GENWORDdC-CSSTART)  ; 
FSTPTR  :=  NEXT;  LMIN  :=  LMIN  +  1 

END 
UNTIL  FSTPTR  =  NIL; 
PUTLABEL(LADDR) 


END; 
IF  SY 


=  ENDSY  THEN  INSYM30L  ELSE  ERR0R(13) 


END  (*CASESTATEMENT*)  ; 

PROCEDURE  REPEATSTATEMENT; 

VAr  LADDR:  LBP; 
BEGIN  GENLABEL(LADDR) ;  PUTLABEL (LADDR ) ; 
REPEAT 

REPEAT  STATEMENT(FSYS  +  C SEMICOLON . UNTILSY D ) 

UNTIL  NOT  (SY  IN  STATBEGSYS); 

TEST  :=  SY  0  SEMICOLON; 

IF  NOT  TEST  THEN  INSYMBOL 
UNTIL  TEST; 
IF  SY  =  UNTILSY  THEN 

3EGIN  INSYMBOL!  EXPRESSION ( FSYS ) ;  GENFJP( LADDR) 

END 
ELSE  ERR0R(53) 
END  (*REPEATSTATEMENT*)  ; 
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13 

54:n 

70 

4018 

13 

55:d 

1 

4019 

13 

55:d 

1 

4020 
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55:4 

59 

4032 

13 

55:3 

59 

4033 

13 
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79 
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PROCEDiJRE    WHILESTATEIWENT; 

var  laddr.  lcix:  lbp; 

BEGIrj  GEiJLABEL(LADDR)  ;  PUTLABEL  (  LADDR  )  ; 

EXPRESSIOrJ{FSrs  +  COOSYJ);  GENLABEL(LCIX);  GEIMFJP(LCIX); 

IF  sr  =  DOSY  THEN  INSYMbOL  ELSE  ERR0R(54); 

STaTEMENT(FSYS)  ;  GEi\|JMP(57(*UJP*)  ,LADDR)  ;  PUTLABEL(LCIX) 
END  {*WHILESTATEMEIMT*)  ; 

PROCEDURE  forstatement; 
var  lattr:  ATTR5  Lsp:  STP;  lsy:  symbol; 
LCIX,  laddr:  lbp; 

BEGIN 

IF  SY  =  IDENT  then 

BEGIN  SEARCHID(VARS,LCP) ; 
WITH  LCP",  LATTR  DO 

BEGIN  TYPTR  :=  IDTYPE;  KIND  :=  VARBL; 
IF  KLASS  =  ACTUALVARS  THEN 

BEGIN  ACCESS  :=  ORCT;  VLEVEL  :=  VLEV« 

DPLMT  :=  VADDR 
END 

ELSE  BEGIN  ERR0R(155);  TYPTR  :=  NIL  END 
END; 
IF  LATTR. TYPTR  <>  NIL  THEN 

IF  (LATTR, TYPTR'". FORM  >  SUBRANGE) 

OR  COMPTYPES(REALPTR, LATTR. TYPTR)  THEN 
BEGIN  ERR0R(143);  LATTR. TYPTR  :=  NIL  END; 
INSYMBOL 
END 
ELSE 

BEGIN  ERR0R(2)!  SKIP(FSYS  +  CBECOMES, T0SYtD0WNT0SY.D0SY3) 
END ; 

IF  SY  =  BECOMES  THEN 

BEGIN  INSYMbol;  EXPRESSION (FSYS  +  CT0SY,D0WNT0SY,D0SY3) ; 
IF  6ATTR. TYPTR  <>  NIL  THEN 

IF  GATTR.TYPTR^.FORM  <>  SCALAR  THEN  ERR0R(144) 
ELSE 

IF  COMPTYPES(LATTR. TYPTR, GATTR. TYPTR)  THEN 
BEGIN  load; 

IF  LATTR. TYPTR  <>  NIL  THEN 

IF  (LATTR. TYPTR*". FORM  =  SUBRANGE)  AND  RANGECHECK  THEN 
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55:6 

63 

4083 

13 

55:5 

a3 

4084 

13 

55:2 

68 

END 

4085 

13 

55:1 

71 

ELSE 
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IF  SY 
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13 
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STATE 
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IF  LS 

BEGIN 

genldc{lattr.typtr'^.min.i\/al)  ; 
genldcjlattr.typtr'^.max.ival)  ; 

GEr«i0(3{*CHK*)  ;i 
END; 
STORE(LATTR) 
END 
ELSE  ERR0R(145) 


IN  ERR0R(5l)!  SKIP{FSYS  +  C TOSY . DOWNTOSY , DOSY D )  END; 
BEL(LADDR) ; 

IN  CT0SY,D0WNT0SY3  THEN 
IN  LSY  :=  SY;  INSYMBOL;  EXPRESSI0N(FSYS  +  CD0SY3); 
F  GATTR.TyPTR  0  NIL  THEN 

IF  GATTR.TYPTR'", FORM  <>  SCALAR  THEN  ERR0R(144) 

ELSE 

IF  COMPTYPES(LATTR,TYPTRtGATTR,TYPTR)  THEN 

BEGIN  load; 

IF  LATTR.TYPTR  <>  NIL  THEN 

IF  (LATTR.TYPTR'". FORM  =  SUBRANGE)  AND  RANGECHECK  THEN 
BEGIN 

GENLDC(LATTR.TYPTR'".MIN.IVAL)  ; 
GENLDC(LATTR.TYPTR'".MAX.IVAL)  ; 
GEN0(8(*CHK*)) 
END? 
GEN2(56(*STR*)  tOfLO;  PUTLABEL  {LADDR  )  ; 
GATTR  :=  LATTR;  LOAD;  GEN2( 54( ♦LOD*) . 0 «LC ) ; 

Lc  :=  Lc  +  intsize; 

IF  LC  >  LCMAX  THEN  LCMAX  :=  LC ; 

IF  LSY  =  TOSY  THEN  GEN2 ( 52 ( ♦LEQ*) . 0 . iNTSIZE ) 

ELSE  GEN2(48(*GEg*) tOiINTSIZE) ; 

END 
ELSE  ERR0R(145) 

BEGIN  ERRGR(55);  SKIP(FSYS  +  CD0SY3)  END; 
BEL(LCIX) ;  GENJMP ( 33( *FJP*) »LCIX) ; 

=  DOSY  THEN  INSYMbOL  ELSE  ERR0R(54); 
MENT(FSYS) ; 

:=  LATTR;  LOAD;  GENLDC(l); 
Y  =  TOSY  THLN  GENO ( 2 ( *ADI* ) )  ELSE  GENO ( 21 { *SBI* ) ) ! 
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STjRE(LATTH)  ;  GEIMJMP  (  57  (  *UJP*  )  ,  LADDR  )  5  PUTLASlL  (  LCIX  )  ; 
LC  :=  LC  -  INTSl^E 
t-ND  (*FORSTATE!«lLrjT*)  ; 


PROCEDURE  WITHSTATEMErjT; 

VAR  lcp:  ctp;  lcnti,lcnt2:  disprange; 

8EGIN  LCNTl  :=  0;  LCNT2  :=  0; 
REPEAT 

IF  SY  =  IDEiMT  THEN 

BEGIN  SEARCHID(VARS  +  CFIELD3, LCP ) ;  INSYMBOL  END 
ELSE  BEGIN  ERR0R(2);  LCP  :=  UVARPTR  END; 
SELECTOR(FSYS  +  CCOMMA» DOSY]. LCP) ; 
IF  GATTR.TYPTR  <>  NIL  THEN 

IF  GATTR.TyPTR^.FORM  =  RECORDS  THEN 
IF  TOP  <  DISPLIMIT  THEN 

BEGIN  TOP  :=  TOP  -»-  l;  LCNTl  ;=  LCNTl  +  i; 
WITH  DISPLAYCTOPD  DO 

BEGIN  FNAME  :=  GATTR.TyPTR'^.FSTFLD  END; 
IF  GaTTR, ACCESS  =  DRCT  THEN 
WITH  DISPLAYCT0P3  DO 

BEGIN  OCCUR  :=  CREC;  CLEV  :=  GATTR. VLEVEL; 

CDSPL  :=  GATTR, DPLMT 
END 
ELSE 

BEGIN  LOADADORESS;  GEN2 ( 56 ( *STR*) , 0 »LC) I 
WITH  DISPLAYCTOPD  DO 

BEGIN  OCCUR  :=  VREC ;  VDSPL  :=  LC  END; 

LC  :=  LC  +  ptrsize;  lcnt2  :=  lcnt2  +  ptrsize; 

IF  LC  >  LCMAX  THEN  LCMAX  :=  LC 
END 
END 
ELSE  ERROR(250) 
ELSE  ERROR(140) ; 
TEST  :=  SY  <>  COMMA; 
IF  NOT  TEST  THLN  INSYMBOL 
UNTIL  TEST; 
IF  SY  =  DOSY  THEN  INSYMBOL  ELSE  ERR0R(54); 

statement(fsys) ; 

top  :=  top  -  lcntl;  lc  :=  lc  -  lcnt2; 
end  (♦withstatement*)  ; 
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BEGirj  (*STATEMLr\IT*) 

STMTlCV  :=  STMTLEV  +  i; 
IF  Sy  =  INTCONST  THEN  (*LABEL*) 
BEGIN  TTOP  :=  TOP; 

vJHiLE  DISPLAYCTTOPJ.UCCJR  <>  ELCK  DO  TTOp  :=  TTOP-1; 
LLP  :=  QISPLAYtTTOPJ.FLABEL; 
'^HlLE.    LLP  <>  NIL  DO 
WITH  LLP''  DO 

IF  LABVAL  =  VAL.IVAL  THEN 
BEGIN 

IF  CODELBP'". DEFINED  THEN  ERR0R(165)! 
PUTlaBELCCODELBP) 5  GOTO  1 
END 
ELSE  LLP  :=  NEXTLAB5 
ERR0R(167) ; 

1:    insymbol; 

if  sy  =  colon  then  insymbol  else  err0r(5) 

end; 
IF  DEBUGGING  THEN 

BEGIN  GENl(a5(*BPT*).SCREEND0TS+l) ;  BPTONLINE  :=  TRUE  END; 
IF  NOT  (SY  IN  FSYS  +  CIDENT3)  THEN 

BEGIN  ERR0R(6);  SKIP(FSYS)  END5 
IF  SY  IN  STATBEGSYS  +  CIDENT3  THEN 

BEGIN  MARK(HEAP)?  (*F0R  LABEL  CLEANUP*) 
CASE  SY  OF 

IDENT:     BEGIN  SEARCHID(VARS  +  CFlELD,FUNC,PROCD,LCP) ; 

insymbol; 

if  lcp^.klass  =  proc  then  call (fsys. lcp) 

else  assignment(lcp) 

END; 

BEGIN  INSYMBOL 
BEGIN  INSYMBOLi 
BEGIN  INSYMBOL 
BEGIN  INSYMBOL 
BEGIN  INSYMBOL 
BEGIN  INSYMBOLI 
BEGIN  INSYMBOLi 
BEGIN  INSYMBOL 


beginsy: 

gotosy: 

ifsy: 

casesy: 

whilesy: 

repeatsy: 

forsy: 

withsy: 
end; 
release(heap) 


compoundstatement  end; 

GOTOSTATEMENT  END; 

ifstatement  end; 
casestatement  end; 
whilestatement  end; 
repeatstatement  end; 

FORSTATEMENT  END; 

withstatement  end 
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IF  IC  +  100  >  MAXCODt  THEN 

3EGIN    ERR0R(253);     IC     :=    0    EMD; 
IF    NOT    (SY    IM    LSEMlCOLOrg,Er\IDSY«ELSESY,UNTILSYJ) 

BEGIN    ERR0R(6);    SKIP(FSYS)    END 

end; 

stmtlev  :=  stvitlev  -  i 

end    (*STATEMENT*)     ; 


then 


PROCEDURE    BODY; 

\/AR  llci,exitic:  addrrange!  lcp:  ctp; 
llp:  labelp;  lmin.lmax:  integer; 
dumiviyvar:   arrayi:o..O]  of  integer; 


lop:  oprange; 
jtinx:  jtabrange; 

(♦FOR  pretty  display 


of  stack  and  heap*) 


BEGIN 

if  (NOSWAP)  and  (STARTINGUP)  THEN 
BEGIN 

declarationpart(Fsys) ;  (*  bring  in  declarationpart  *) 
exit(bodypart) ; 
end; 
nextjtab  :=  1; 
if  noisy  then 

begin  WRITELNCOUTPUT) ; 
if  not  noswap  then  (*must 

unitwrite(3,dummyvarc-1600  3.35) 
dummyvarco::=memavail; 

IF  DUMMYVARCOD  <  SMALLESTSPACE  THEN  SMALLESTSPACE:=DUMMYVARC03; 
IF  FPROCP  <>  NIL  THEN 

WRITELNCOUTPUTtFPROCP'^.NAME.'  C  •  .DUMMYVARC  0  3:5.  *  W0RDS3*); 
WRlTE( OUTPUT* »<'.SCREEND0TS:4.'>M 

end; 

IF  FPRocP  <>  NIL  THEN 


ADJUST  DISPLAY  OF  STACK  AND  HEAP*) 


BEGIN 

LLCl  :=  FPROCP'^. LOCALLC; 
WHILE  LCP  0  NIL  DO 
WITH  LCP**  DO 
BEGIN 

IF  IDTYPL  <>  NIL 


LCP  :=  FPROCP^. NEXT; 


THEN 
IF  (KLASS  =  ACTUALVARS)  THEN 

IF  (IDTYPE'^.FORM  >  POWER)  THEN 
BEGIN  LLCl  :=  LLCl  -  PTRSI2E; 
eEN2(50(*LDA*).0.VADDR); 
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32 

bEN2(54(*L0D*) tOtLLCl) ; 
IF  PAOFCHARdDTYPE:)  THEN 
WITH  IDTYPE'^  DO 

IF  AISSTRNG  THEN  GENl ( 42 ( *SAS* ) , MAXLENG ) 
ELSE 

IF  INXTYPE  0  NIL  THEN 

BEGIN  GETBOUNDS(INXTYPE,LMINiLMAX)  ; 

GEN1(40(*M0V*) » (LMAX-LMlN+1+1)  DIV  2) 
END 
ELSE 
ELSE  GEN1{40(*MOV*).IDTYPE'*.SIZE) 
END 
ELSE  LLCl  :=  LLCl  -  IDTYPE^.SIZE 
ELSE 

IF  KLASS  =  FORMALVARS  THEN  LLCl  :=  LLCl  -  PTRSI2E; 
LCP  :=  NEXT 
END; 

end; 

STARTDOTS  :=  SCREENDOTS; 
LCMAX  :=  Lc; 

LLP  :=  DISPLAYCT0P3.FLABEL; 
WHILE  LLP  <>  NIL  DO 

begin  genlabel(llp''.codelbp); 

llp  :=  llp'^.nextlab 
end; 
if  not  inmodule  then 

IF  LEVEL  =  1  THEN 

BEGIN  LCP  :=  usinglist; 

WHILE  LCP  0  NIL  DO 
BEGIN 

IF  LCP'^.SEGID  >=  0  THEN 

BEGIN  GENLDC<LCP''.SE6ID)  ;  GENl  (  30  (  ♦CSP* )  1 21  (  ♦GETSEG*  )  )  END; 
LCP  :=  LCP'^.NEXT 

end; 

IF  USERINFO. STUPID  THEN 

GEN2(77(*CXP*)  .6(*T'JRTLE*)  «1{*INIT*)) 

end; 
LCP  :=  DISPLAYCT0P3.FFILE; 
WHILE  LCP  0  NIL  DO 
WITH  lCP'^iIOTYPE'^  DO 

BEGIN 
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THEN  GENLDC(O) 


GEN2{50(*LOa*) tOf VADDk)  ; 
GEN2(50(*LDA*) ♦ 0 , VADDR+FILESIZE ) 
IF  FILTYPE  =  NIL  THEN  GENLDC(-l) 
ELSE 

IF  IDTYPE  =  INTRACTVPTR 
ELSE 

IF  FILTYPE  =  CHARPTR  THEN  GENlDC(-2) 
ELSE  GENLDCCFILTYPE-^.SIZE); 
GEN2{77(*CXP*) .0{*SYS*) ♦ 3 ( *FINIT*) ) ; 
LCP  :=  NEXT 
ENO; 
IF  (LEVEL  =  1)  AND  NOT  SYSCOMP  THEN 

GEN1{85(*BPT*)»SCREEND0TS+1) ; 
REPEAT 

REPEAT  STATEMENT(FSYS  +  CSEVIIC0L0N,ENDSYD) 

UNTIL  NOT  (SY  IN  STATBEGSYS); 

TEST  :=  SY  <>  SEMICOLON; 

IF  NOT  TEST  THEN  INSYMBOL 
UNTIL  TEST; 
IF  SY  =  ENDSY  THEN  INSYMBOL  ELSE  ERR0R{13); 

EXiTic  :=  ic; 

LCP  :=  DISPLAYCTOPJ.FFILE; 
WHILE  LCP  0  NIL  DO 
WITH  LCP**  DO 
BEGIN 

GEN2(50(*LDA*) tOiVADDR)  ; 

GENLDC(O);  GEN2(77(*CXP*),0(*SYS*),6(*FCLOSE*)); 
LCP  :=  NEXT 

end; 

IF  NOT  INMODULE  THEN 
IF  LEVEL  =  1  THEN 
BEGIN 

LCP  :=  USINGLIST; 
WHILE  LCP  <>  NIL  DO 
BEGIN 

IF  LCP'.SEGID  >=  0  THEN 

BEGIN  GENLDCCLCP-.SEGID);  GENl ( 30 ( ♦CSP*) ,22 ( *RELSEG* ) ) 
LCP  :=  LCP". NEXT  '♦*:*:t*KLL&Lb*jj 

END 

end; 

IF  FPROCP  =  NIL  THEN  GENO ( 86 ( *XIT*) ) 


end; 


431 


432 


4296  13  57:i  S4  ELSE 

4297  13  57:2  63  3EGIM 

4298  13  57:3  63  IF  pPROCP" . PFLEV  =  0  THEN  LOP  :=  65(*RBP*) 

4299  13  57:3  77  ELSE  LOP  :=  45(*RNP*); 

4300  13  57:3  85  IF  FPROCP'^.IDTYPt  =  NIL  THEN  GEN1(LOP«0) 

4301  13  57:3  95  ELSE  GENl  (  LOP  ,  PPHOCP'^ .  IDT  YPE"  .  SIZE  ) 

4302  13  57:2  05  end; 

4303  13  57:1  07  LLP  :=  QlSPLAYC TOPl.FLABEL ;   (*  CHECK  UNDEFINED  LABELS  *) 

4304  13  57:1  15  WHILE  LLP  <>  NIL  DO 

4305  13  57:2  20  WITH  lLP'^  1 C0DEL3P'"  DO 

4306  13  57:3  27  BEGIN 

4307  13  57:4  27  IF  NOT  DEFINED  THEN 

4308  13  57:5  32  IF  REFLIST  <>  MAXADDR  THEN  ERR0R{168); 

4309  13  57:4  46  LLP  :=  NEXTLAB 

4310  13  57:3  46  END; 

4311  13  57:1  52  JTINX  :=  NEXTJTAB  -  1; 

4312  13  57:1  59  IF  ODD(lC)  THEN  IC  :=  IC  +  1? 

4313  13  57:1  67  WHILE  JTiNX  >  0  DO 

4314  13  57:2  72  BEGIN  GENWORD( IC-JTABC JTINXD) ;  JTINX  :=  JTlNX-1  END; 

4315  13  57:1  91  IF  FPROCP  =  NIL  THEN 

4316  13  57:2  98  BEGIN  GENWORD( (LCMAX-LCAFTERMARKSTACK ) *2) ;  6ENW0RD(0)  END 

4317  13  57:1  11  ELSE 

4318  13  57:2  13  WITH  pPROCP'^  DO 

4319  13  57:3  18  BEGIN  GENW0RD((LCMAX-L0CALLC)*2) ; 

4320  13  57:4  29  GENW0RD((L0CALLC-LCAFTERMARKSTACK)*2) 

4321  13  57:3  36  end; 

4322  13  57:1  39  GENW0RD( IC-EXITIC ) ;  GENWORD(IC); 

4323  13  57:1  49  GEN3YTE ( CURPROC ) ;  GENBYTE { LEVEL-1 ) ; 

4324  13  57:1  61  IF  NOT  cODEINSEG  THEN 

4325  13  57:2  66  BEGIN  CODEINSEG  :=  TRUE; 

4326  13  57:3  69  SEGTABLECSEGD.DISKADDR  :=  CURBLK 

4327  13  57:2  77  END; 

4328  13  57:1  61  WRITECodE(FALSE) ; 

4329  13  57:1  85  SEGINX  :=  SEGINX  +  IC; 

4330  13  57:1  91  PR0CTA3LECCURPR0CJ  :=  SEGINX  -  2 

4331  13  57:0  00  END  (*B00Y*)  ? 

4332  13  57:0  42 

4333  13  1:0  0  BEGIN  (*aoDYPART*) 

4334  13  1:1  0  BODY 

4335  13  1:0  0  END  ; 

4336  13  1:0  1*+ 
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a^?f  li  V'^  ^'*  <*^^  «5:30DYPART.E.TEXT*) 

aitl  ^t  ^'^  ^"^     <**!  «?:JNITPART.TEXT*) 

'+339  13  i:o  m 

^3'+0  13  i:o  in 

'+3'+i  13  i:o  in 


^Z^2 


13     i;?     in      !:*******************************♦*************************♦*♦***♦*, 


43f^  ii     i.*n  Ju  *   COPYRIGHT  (C)  L979  REgEMTS  OF  THE  UNIVERSITY  OF  CALIFORNIA     *\ 

mi  13     ?:?  '^  *   ^EIRMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCuSeN-'    * 

-+346  ll            i:o  ll  *  ^''V''''    ^''    """^^    °^  S°^T  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE    * 

^7  13     u'o  J^  !*   OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS.  *J 

nil  13     III  ll  ^**************************************************^^^ 

nil  ll  i!d      2  ^^?YPE^  PROCEDURE  WRITELINKERINF0( DECSTUFF:BOOLEaN) ; 

'+353  14  lis  2  ""^^^^^^    "    *^°^r?^n;c°°S^^^'^'-°^'^^^'''^SBLlC,PRlVVATE,CONNSTANT,GLOBDEF. 

435«l  14  1:d  2  ^^^licdef,constdef,extproc.extfunc.ssepproc,ssepfunc,       ^ 

431,8:  in  i,r,  ^  J>t.rrREF « SLRFREF )  i 

4356  14  J:n  ?  OPFORMAT  =  (WORD.  BYTE.  BIG)» 

4357  ll  J.'n  o  ^IENtRY  =  RECORD 

435I  ll  I'n  I  LINAME:  ALPHA, 

4359  X4  i*D  P  ^^^^  LITYPE:  LITYPES  OF 

Jllo  i^  i^n  ^  MODDULE. 

4361  14  i'n  7  PUBBLIC, 

'+362  ll  i-'n  2  PRIVVATE, 

'+363  14  I'n  2  SEPPREF. 

'+364  14  I'D  2  SEPFREF:           (FORMAT:  OPFORMAT; 

'+365  li+  I'D  2  NREFS:  INTEGER; 

*+366  14  i:n  9  r.         ^                                      NWORDS:  INTEGER); 

^+367  14  ID  2  CONSTDEF:          (CONSTANT:  INTEGER); 

4368  14  i:S  2  Ex?PRO?^F;Trn.r    '  S^^^EOFFSET:  INTEGER,; 

4369  14  I'n  %  EXTPROCEXTFUNC, 

4370  14  i-D  2  ssepproc.ssepfunc:(procnum:  integer; 

'+371  14  1:d  2  'MPARAMS:  INTEGER; 

'+372  14  1:d  2  rMn.                    RANGE:  ^INTEGER) 

^+373  14  1:0  2 

^1375  14  i-D  I         ^'^^  rv^'l:5^*  ^^^'  CURRENTBLOCK:  INTEGER;  I:  NONRESIDENT; 

4376  14  J'n  ..  EXtnAME:  ALPHA;  FIC:  ADDRRANGE; 

•+376  14  l.D  11  LIREC:  LIENTRY; 


133 


ivJ4 


4377 

14 

i:d 

19 

4373 

14 

2:d 

1 

4379 

14 

2:r. 

3 

4380 

14 

Zlo 

a 

4331 

14 

5:d 

1 

4382 

14 

3:o 

0 

4383 

14 

3:i 

0 

4384 

14 

3:i 

8 

4385 

14 

3:i 

21 

4386 

14 

3:o 

42 

4387 

14 

3:o 

54 

4388 

14 

2:0 

0 

4389 

14 

2:1 

0 

4390 

14 

2:1 

17 

4391 

14 

2:1 

20 

4392 

14 

2:2 

33 

4393 

14 

2:3 

33 

4394 

14 

2:3 

56 

4395 

14 

2:4 

67 

4396 

14 

2:5 

80 

4397 

14 

2:3 

04 

4398 

14 

2:2 

13 

4399 

14 

2:1 

20 

4400 

14 

2:1 

35 

4401 

14 

2:1 

35 

4402 

14 

2:0 

53 

4403 

14 

2:0 

82 

4404 

14 

4:d 

1 

4405 

14 

4:d 

2 

4406 

14 

4:d 

3 

4407 

14 

4:0 

0 

4408 

14 

4:1 

0 

4409 

14 

4:1 

3 

4410 

14 

4:2 

6 

4411 

14 

4;2 

11 

4412 

14 

4:2 

16 

4413 

14 

4:4 

27 

4414 

14 

4:5 

31 

4415 

14 

4:4 

32 

4416 

14 

4:3 

37 

4417 

14 

4:2 

44 

PROCEDURE    GETREFSdD. LENGTH:     IfgTEGER); 

VAR  ;.ic:  adurramge;  j, max, blockcount, count:  integer; 
PROCEDURE  getnextblock; 

3EGIN 

CURRENTBLOCK  :=  currentblock  +  i; 

IF  CURRENTBLOCK  >  REFBLK  THEN  CURRENTBLOCK  : =  05 

IF  BLOCKREAD(REFFILE»REFLIST'*,ltCURRENTBL0CK)  <>  1  THEN; 

END  (*GETNEXTBL0CK*)  ; 

BEGIN  (*GETREFS*) 

IF  (NREFS  =  1)  AND  (REFBLK  =  0)  THEN  EXIT(GETREFS ) ; 

COUNT  :=  0; 

FOR  BLOCKCOUNT  :=  0  TO  REFBLK  DO 
BEGIN 

IF  CURRENTBLOCK  <  REFBLK  THEN  MAX  :=  REFSPERBLK  ELSE  MAX  :=  NREFS-l; 
FOR  J  :=  1  TO  MAX  DO 

IF  ID  =  REFLIST'*CJ3,KEY  THEN 

BEGIN  GENWORDCREFLIST'^CJD. OFFSET)  ;  COUNT  :=  COUNT  +  1  END; 
IF  BLOCKCOUNT  <  REFBLK  THEN  GETNEXTBLOCK ; 
END; 

Lie  :=  ic;  ic  :=  fic;  genwordccounT) ;  ic  :=  Lie; 

(♦NOW  FILL  REST  oF  8-WORD  RECORD*) 

FOR  J  :=  1  TO  ((8  -  (COUNT  MOD  8))  MOD  8)  DO  GENWORD(O) 
END  (*  gETREFS  *)  ; 

PROCEDURE  GLOBALSEARCH{FCP;  CTP); 
VAR  NEEDEDBYLINKER:  BOOLEAN; 

BEGIN 

NEEDEDBYLINKER  :=  TRUE! 
WITH  LlRECFCP^  DO 
CASE  KLASS  OF 

types:  NEEDEDBYLINKER  :=  FALSE; 

KONST:  if  (IDTYPE'^.SIZE  =  D  and  not  INMODULE  THEN 
BEGIN  LITYPE  :=  CONSTDEF; 
CONSTANT  :=  VALUES. IVAL 
END 
ELSE  NEEDEDBYLINKER  :=  FALSE; 
FORMALVARSi 


'f'+ia 

14 

4:2 

44 

4^19 

14 

4:3 

44 

4420 

14 

4;i+ 

44 

4421 

14 

4:5 

48 
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14 
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48 

4423 
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53 
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57 

4425 

14 
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57 

4426 

14 

4:6 

51 

4427 

14 

4:7 

63 

4428 

14 

4:8 

67 

4429 

14 

4:9 

74 

4430 

14 

4:8 

74 

4431 

14 

4:9 

30 

4432 

14 

4:7 

82 

4433 

14 

4:6 

86 

4434 

14 

4:5 

86 

4435 

14 

414 

90 

4436 

14 

4:5 

92 

4437 

14 

4:6 

96 

4438 

14 

4:5 

96 

4439 

4:3 

02 

4440 

4:2 

04 

4441 

4:2 

09 

4442 

4:2 

09 

4443 

4;4 

09 

4444 

4:5 

16 

4445 

4:6 

23 

4446 

4:7 

30 

4447 

4:8 

35 

4448 

4:8 

39 

4449 

4:7 

45 

4450 

4:3 

51 

4451 

4:9 

55 

4452 

4:8 

55 

4453 

4:6 

61 

4454 

4:7 

66 

4455 

4:8 

71 

4456 

4:8 

75 

4457 

4:7 

81 

4458 

4:8 

87 

PUBBLIC 


:=  privvate; 
=  formalvars  then 

:=  PTRSIZE 

:=  IDTYPE'^.SIZE 


PUBLICDEF; 
VADDR 


ACTUALVARS: 
BEGIN 

IF    INMODULE    THEiM 
dEGiiM 

IF  PUBLIC  THEN 
BEGIN  LITYPE 

IMWORDS  :=  0 
END 
ELSE 

BEGIN  LITYPE  : 
IF  KLASS 
NWORDS 
ELSE 

NWORDS 

end; 
format  :=  big 

END 
ELSE 

BEGIN  LITYPE  := 
BASEOFFSET  := 

END 
END  5 

field:  neededbylinker  :=  false; 

PROC, 

FUNC:   BEGIN 

IF  PFDECKIND  r  DECLARED  THEN 
IF  PFKIND  =  ACTUAL  THEN 
IF  KLASS  =  PROC  THEN 
IF  EXTURNAL  THEN 

IF  SEPPROC  THEN  LITYPE  :=  SEPPREF 
ELSE  LITYPE  :=  EXTPRQC 
ELSE 

IF  SEPPROC  THEN 

LITYPE  :=  SSEPPROC 
ELSE  NEEDEDBYLINKER  :=  FALSE 
ELSE  <*KLASS  =  FUNG*) 
IF  EXTURNAL  THEN 

IF  SEPPROC  THEN  LITYPE  :=  SEPFREF 
ELSE  LITYPE  :=  EXTFUNC 
ELSE 

IF  SEPPROC  THEN 


43; 
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14 
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t:8 
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'+'+61 
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97 
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14 

414 
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IH 
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1^ 
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44 
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14 
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58 
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65 
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85 
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94 
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1*+ 
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'+'+81 

1'+ 
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16 
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It 
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26 
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t:3 

26 
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It 

t:2 

28 

4485 

It 
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28 
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4:4 

33 

'+'+87 

It 

t:5 

38 
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It 
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50 
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It 

t:2 
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It 

t:i 

76 
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It 
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79 
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It 
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90 
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It 
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4494 

It 

t:5 

03 
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It 

t:i 
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It 

t;2 

09 

4497 

It 

t:3 

09 
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14 

t:4 

15 

4499 

It 

4:4 

46 

wiooule: 


HTY°t:    :=    SSEPFUNC 
E:LS£    riEEDEDBYLlNKER    :=    FALSE 

elsl  neededbylinker   :=  false 
else  imeeded3ylimker   :=  false; 

IF  rjEEDEDBYLINKER  THEN 

BEGIN 

LCP  :=  NEXT;  NPARAMs  :=  o; 

WHILE  LCP  <>  NIL  DO 
BEGIN 

WITH  LCP'^  DO 

IF  KLASS  =  FORMALVARS  THEN 

NPARAMS  :=  NPARAMS  +  PTRSIZE 
ELSE 

IF  KLASS  =  ACTUALVARS  THEN 

IF  IDTYPE'^.FGRM  <=  POWER  THEN 

NPARAMS  :=  NPARAMS  +  IDTYPE'^.SIZE 
ELSE  NPARAMS  :=  NPARAMS  +  PTRSIZE? 
LCP  :=  LCP'^.NEXT 
END? 
IF  LITYPE  IN  CSEPPREF«SEPFREF3  THEN 

BEGIN  FORMAT  :=  BYTE;  NWORDS  :=  NPARAMS  END 
ELSE 

BEGIN  PROCNUM  :=  PFNAME;  RANGE  :=  NIL  END 
END 
END  (*PROC»FUNC*) ; 
BEGIN 

THEN  NEEDEDBYLINKER  :=  FALSE 


IF  NOT  INMODULE 
ELSE 

BEGIN  LITYPE  : 
END 
END  (*CASEfWITH*) 5 
IF  NEEDEDBYLINKER  THEN 

IF  SEGTABLECSEG^.SEGKIND  =  2 
WITH  LIREC  DO 

IF  (LITYPE  =  CONSTDEF)  OR 
NEEDEDBYLINKER  :=  FALSE; 
IF  NEEDEDBYLINKER  THEN 
WITH  LIREC  DO 

3EGIN  LINAME  :=  FCP'^.NAME; 

FOR  LGTH  :=  1  TO  a  DO  GENBYTE ( ORD{ LINAMECLGTH3) ) 
GENWORDCORDILITYPE) ) ; 


=  MODDULE;  NWORDS  :=  0;  FORMAT  :=  BYTE  END 

(♦SEGPROC*)  THEN 
(LITYPE  =  PUBLICDEF)  THEN 
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CASE    LITYPE    OF 
•ViODDULE, 
PUBBulC, 
PRIVVATt, 

scppref.sepfhef: 


=  MODDULE  THEN  GETREFS(FCP'^,SEGID,  1 ) 


THEN 


constdef:  begin 
publicdef:  begin 
extproc.extfunc: 


ssepprocssepfunc: 


IF 


END(*CASE*) 
END(*WITH*) ; 
IC  >=  1024  THEN 


BEGIN 

GL(\iWORD(ORD(FORMAT)  )  ; 
FIC  :=  IC;  GENWORD(O); 
GENWORD(NWORDS) ; 
IF  LITYPE 
ELSE 
IF  LITYPE  IN  CSEPPREF,SEPFREF3 
GETREFS(-FCP'*.PFNAMEfl) 

ELSE  GETREFS(FCP'*.VADDR  +  32f  FCP*^.  IDTYPE'^.SIZE)  ; 
END;  *«-t'. 

GENW0R0(C0NSTANT)5  GENWORDCO);  GENWORDCO)  END; 
6ENW0RD(BASE0FFSET);  GENWORD(O);  GENWORD(O)  END; 
BEGIN 

GENWORD(PROCNUM); 

GENWORDCNPARAMS) ; 

GENWORD<ORD(RANGE)) 
END; 
BEGIN 

GENWORD(PROCNUM); 

GENWORD(NPARAMS) t 

GENWORD{ORD(RANGE)) 5 

FOR  LGTH  :=  I  TO  8  DO 

GENBYTE(0RD(LINAMECLGTH3) ) ; 
IF  LITYPE  =  SSEPPROC  THEN 

GENW0RD{0RD{SEPPREF) ) 
ELSE  GENW0RD(0RD(SEPFREF>>; 
GENW0RD(0RD(BYTE))  ; 

FIC  :=  IC;  GENWORD(O);  GENWORD(NPARAMS) J 
GETREFSi-PROCNUMtl) 
END 


BEGIN  writecode(false);  ic  :=  0  end; 


IF  FCP'^.LLINK  0 

IF  fcp^.rlink  0 


NIL  THEN  GLOBALSEARCHtFCP'^.LLINK); 
NIL  THEN  GLOBALSEARCH(FCP'*.RLINK) 
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4:q 
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i:o 

i:i 

i:i 

i:i 

1:2 

1:1 
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1:3 

1:2 

1:2 

1; 

1; 

1; 

1; 


END  (*gl03alsearch*) ; 


;i 
;2 

13 
4 
5 
5 
5 
5 
5 

:5 
7 
5 
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1:5 
1:5 
1:6 
1:7 
1:7 
1:6 
1:5 
1:6 
1:7 
1:6 
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i: 

1 
1: 

1; 
1; 


oc 
0 
0 
6 
13 
17 
22 
25 
34 
40 
42 
42 
42 
54 
65 
65 
68 
88 
08 
28 
48 
63 
75 
95 
14 
45 
49 
53 
69 
78 
80 
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02 
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13 
20 
20 
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54 


•  EG  IN 
IC 
IF 
IF 


IF 


D 
BE 


EN 
(*N0 
kJITH 

FO 


(*;j-UTELIfJKERlfjFO*) 

=  0; 

ODeiNSEG  then  ERR0R(399)! 

NM3DLILE    THEN 

CURRENT3L0CK  :=  REFBLK; 

ECSTUFF  then  {*SKIP  IF  NO  DECLARATIONPART 

GIN  FCP  :=  DlSPLAYCGLEV3.FNflME; 

IF  FCP  0  NIL  THEN  GLOBALSEARCH (FCP ) 

d; 

w  do  nonresident  procs*) 

LIREC  00 
R  I  :=  SEEK  TO  DtCOPS  DO 
IF  pFNUMOFCn  <>  0  THEN 
3EGIN 


LINKER  INFO*) 


CASE  I  OF 

seek: 

freadreal: 

fwritereal: 

freaddec: 

fwritedec: 


DECOPS: 

end; 

FOR  LGTH 


BEGIN 

begin 
begin 
begin 

BEGIN 
BEGIN 


LINAME  :=  'FSEEK    ♦;  NPARAMS  :=  2  END; 

LINAME  :=  'FREADREA*;  NPARAMS  :=  2  END; 

LINAME  :=  'FWRITEREM  NPARAMS  :=  5  END; 

LINAME  :=  'FREADDEC' 5  NPARAMS  ;=  3  END; 
LINAME  :=  'FWRITEDE'; 

NPARAMS  :=  2+DECSlZE(MAXDEC)  END; 

LINAME  :=  'DECOPS   M  NPARAMS  :=  0  END; 


:=  1 


(♦  N 

FOR 

GENW 

GENW 


TO  8  DO  GENBYTE{0RD(LINAMECLGTHD)) ; 
IF  SEPPROC  THEN 

BEGIN  GENWORD(ORD(SEPPREF) ) ; 

GENWORD(ORD(BYTE) ) ;  FIC  :=  IC;  GENWORD(O);  GENWORD{ NPARAMS) ; 
GETREFS{-PFNUM0FCID,1) 
END 
ELSE 

BEGIN  GENWURD(ORD{EXTPROC) ) ; 

GENWORDiPFNUMOFCiD) ;  GENWORD (NPARAMS) ;  GENWORD(O) 
END; 
PFNUMOFCID  :=  0; 
enO; 
ow  do  eofmark  end-record*) 
lgth  :=  1  to  8  do  genbyte ( ord ( •  •)); 
ord(ORd{eofmark) ) ;  genworo{lcmax) ; 
ord(o) ;genword(0) ; 
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3:3 

42 

4609 

15 

3:3 

45 

4610 

15 

3:3 

48 

4611 

15 
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WRiTECODtCTRUE) ; 
CLINKE^IiMFO  :=  FALSE? 

IF  DEC3TUFF  THEf'J  DLINKEKINFO  :=  FALSE 
END  (*WRiTELir\IKEKlNFO*)  ; 

SEGMENT  PROCEDURE  UNITPART ( FSYS :  SETOFSYS); 
VAR  UMaRKP:  TESTP; 

PROCEDURE  OPENREFFILE; 
BEGIN 

REWRITECREFFILE, •♦SYSTEM. INFOC*]*); 
IF  lORESULT  0  0  THEN  ERROR(402) 
END  (*  OPENREFFILE  *)  5 

PROCEDURE  UNITDECLARATION(FSYS:  SETOFSYS;  VAR  UMARKPITESTP) ; 

VAR  lcp:  ctp;  found:  boolean;  llexstk:  lexstkrec; 

BEGIN 

if  INMODULE  then  ERR0R{182  (*  NESTED  MODULES  NOT  ALLOWED  ♦)); 

IF  codeinseg  then 
BEGIN  ERR0R(3g9);  SEGiNx  :=  o;  curbyte  :=  0  end; 

WITH  llexstk  do 
BEGIN 

DOLDTOP  :=  TOPS 
OOLDLEV  :=  LEVEL; 
POLDPROC  :=  CURPROC; 
SOLDPROC  :=  NEXTPROC; 

DOLDSEG  :=  seg; 

DLLC  :=  LC; 
PREVLEXSTACKP  :=  TOS 

end; 
SEG  :=  nextseg; 

NEXTSEG  ;=  NEXTSEG  +  i; 

IF  NEXTSEG  >  MAXSEG  THEN  ERROR(250); 

NEXTPROC  :=  1; 

LC  :=  lcaftermarkstack; 

PUBLICPROCS  :=  FALSE; 

INMODULE  :=  TRUE; 

INSYM30L; 

IF  Sy  O  IDENT  THEN  ERR0R(2) 

ELSE 

BEGIN  FOUND  :=  FALSE; 
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:=  modptr; 


lcp   :=  modptr; 

/jhile  (lcp  <>  nil)  and  not  found  do 

IF  LCP'^.NAft'lE  0  ID  THEN  LCP  :=  LCP-^.NEXT 
ELSE  BEGIN  FOUND  :=  TRUE?  ERROR(lOl)  ENDS 
IF  NOT  FOUND  THEN 

8EG1N  NEW(LCP«|WODULE)  ; 
WITH  LCP-  DO 

BEGIN  NAME  :=  ID;  IDTYPE  :=  NIL;  NEXT 

KLASS  5=  MODULE;  SEGID  :=  SEG 
END; 
MODPTR  :=  LCP 
END; 

end; 
segtablecsegd.segname  :=  id; 

mark(umarkp) ; 

new(reflist) ; 

newctos); 

tos'*  :=  LLEXSTK; 

LEVEL  :=  1$ 

if  top  <  DISPLIMIT  THEN 

begin  top  :=  top  +i! 

WITH  DISPLAYCT0P3  DO 

BEGIN  FNAME  :=  NIL?  FFILE  :=  NIL?  FLABEL  :=  NIL;  OCCUR  :=  BLCK  END; 
IF  LCP  0  NIL  THEN  ENTERID(LCP) 
END 
ELSE  ERROR(250) ; 
INSYMBOH 
IF  SY  =  SEMICOLON  THEN  INSYMBOL  ELSE  ERR0R(14) 

end  (*unitdeclarati0n*)  5 

begin  (*unitpart*) 
openreffile; 

REPEAT 

reset(REFFILE);  nrefs  :=  i;  refblk  :=  o; 

IF  (SY  =  SEPARATSY)  THEN 

BEGIN  SEPPROC  :=  TRUE; 

INSYMBOL;  if  SY  <>  UNITSY  then  ERR0R(24) 

END 
ELSE 

SEppROC  :=  FALSE? 
UNlTOECLARATION(FSYSf UMARKP)  ; 
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IF  SEPPROC  THEN  SEGTA3LEC SEG J.SEGKINQ  :=  4  ELSE  SE6TABLEC SEGD.SEGKIND  :=  3! 
SEGTABLECSEG3.TEXTADDR  :=  CUR3LK; 
WRITETEXT; 

IF  SY  =  INTERSY  THEN  INSYMBOL 
ELSE  ERR0R(22) ; 
ININTERFACE  :=  TRUE; 
OECLARATIONPART(FSYS) ; 
IF  PJBLICPROCS  THEN 
BEGIN 

ININTERFACE  ;=  FALSE; 

IF  SY  <>  IMPLESY  THEN  BEGIN  ERR0R(23);  SKIP(FSYS  -  STATBEGSYS)  END 

ELSE  insymbol; 

BLOCK(FSYS  -  CSEPARATSY t UNITSY* iNTERSY. IMPLESY3) ; 
IF  REFBLK  >  0  THEN 

IF  BLOCKWRlTE(REFFlLEfREFLIST'^,l, REFBLK)  <>  1  THEN  ERROR(402); 
WRITELINKERINFO(TRUE)  ; 
ENO 
ELSE 

BEGIN  DLINKERINFO  :=  FALSE; 
WITH  SEGTABLECSEG3  DO 

BEGIN  CODELENG  :=  0;  DISKADDR  :=CURBLK;  SEGKIND  :=  0  END; 

end; 
sepproc  :=  false;  {*false  whenever  not  inmodule*) 
inmodule  :=  false; 

IF  SY  =  ENDSY  THEN  INSYMBOL 

ELSE  BEGIN  ERR0R{13);  SKIP(FSYS)  END; 

IF  SY  <>  PERIOD  THEN 

IF  SY  =  SEMICOLON  THEN  iNSYi'IBOL 
ELSE  ERR0R(14) ; 
WITH  TOS*^  DO 
3EGIN 

TOP  :=  DOLDTOP; 
LEVEL  :=  DOLDLEV; 
CURPROC  :=  PULDPROC; 
NEXTPROC  :=  SOLDPROC; 
SEG  :=  doldseg; 
LC  :=  DLLC; 
END; 
IDS  :=  TOS-^.PREVLEXSTACKP; 
RELEASE(JMARKP) 
UNTIL  'nJOT  (SY  IN  CU^\llTSY.SEPARATSYJ)  ; 
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(♦$1  tt5:UNlTPART.TEXT*) 

(*$i  »5:procs.a.text*) 


49    CLOS£(REFFILE) 

56  END  (♦UNITPART*) ; 
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(* 
(* 
(* 
(* 
(* 
(* 


COPYRIGHT  (C)  L979  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA. 
PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN- 
TATION IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE 
OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS, 


*) 
*) 
*) 
*) 
*) 
♦  ) 


(♦♦♦j|:***#********#************  ********♦****♦**♦**♦*♦♦♦*♦♦*♦**♦♦****) 


PROCEDURE  ERR0R(*ERR0RNUM;  INTEGER*) » 
VAR  CH:  CHAR;  ERRSTART;  INTEGER; 

a:  PACKED  ARRAY  CO.. 1793  OF  CHAR? 
0  BEGIN 

0    WITH  USERINFO  DO 

3      IF  (ERRSYM  <>  SYMCURSOR)  OR  (ERRBLK  <>  SYMBLK)  THEN 
17        BEGIN  ERRBLK  :=  SYMBLK; 
24  ERRSYM  :=  SYMCURSOR;  ERRNUM  1=  ERRORNUM; 

36  IF  STUPID  THEN  CH  :=  'E* 
41          ELSE 

46  BEGIN 

46  IF  NOISY  THEN  WRITELN (OUTPUT ) 

56  ELSE 

58  IF  LIST  AND  (ERRORNUM  <=  400)  THEN 

68  EXIT(ERROR); 

72  IF  LINESTART  =  0  THEN 

78  WRITE(OUTPUT»SYMBUFP'":SYMCURSOR) 

69  ELSE 

91  BEGIN 

91  ERRSTAKT  :=  SCAN ( - ( LINESTART-1 ) »=CHR ( EOL ) f 

93  SYM3UFP"C LI NEST ART-2D)+LI NEST ART-1; 

13  MOVELEFT(SYM3UFP'*CERRSTART3.AC0D,SYMCURSOR-ERRSTART)  ; 

?.i  WRITE  (OUTPUT. a:SYV1CURS0R-ERRSTART) 

37  end; 

37  aRITELN(OUTPUT» •  <<<<•); 
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END 


WRlTiTCOUTPUT,  'LINE 
IF  NOISY  THEN 

WrtITE(OUrPUT» •  <SP>( CONTINUE) » 
WRITE(0UTPUT,CHFU7)  )  ; 
REPEAT  READ(KEYBOARDfCH) 
UNTIL  (CH  =  •  •  )  OR  (CM  =  'EM  OR 
END; 
IF  (CH  =  •£•)  OR  (CH  =  'EM  THEN 

BEGIN  ERRBLK  :=  SyMBLK-2;  EXIT ( PASCALCOMPILER ) 
IF  (ERRORNUM  >  400)  OR  (CH  =  CHR(27))  THEN 

BEGIN  ERRBLK  :=  0;  EXIT ( PASCALCOMPILER )  END; 
WRIT£LN(0UTPUT)  ; 
IF  NOISY  THEN 

WRITE (OUTPUT  I K'fSCREENDOTS: 4, •>• ) 
END 
(♦ERROR*)  ; 


• tSCREENDOTSt • ♦  ERROR  '. ERRORNUM : 0  .':»)  ; 
<ESC>(TERMINATE) t  E(DIT«); 

(CH  =  'E')  OR  (CH  =  ALTMODE) 

END; 


PROCEDURE  GETNEXTPAGE5 

BEGIN  SYMCURSOR  :=  0;  LINESTART  :=  O; 
IF  USING  THEN 
BEGIN 

IF  USEFILE  =  WORKCODE  THEN 
BEGIN 

IF  BL0CKREAD(USERINF0, WORKCODE^, SYMBUFP'^.Z.SYMBLK)  <>  2  THEN 
USING  :=  FALSE 
END 
ELSE 

IF  USEFILE  =  SYSLIBRARY  THEN 

IF  BL0CKREAD(LlBRARYiSYMBUFP''t2fSYMBLK)  <>  2  THEN 

USING  :=  false; 

IF  NOT  USING  THEN 
BEGIN 

SYMBLK  :=  prevsymblk;  SYMCURSOR  ;=  prevsymcursor; 

LINESTART  ;=  PREVLINESTART 
END 

end; 
if  not  using  then 

BEGIN 

IF  INCLUDING  THEN 

IF  BL0CKREAD(INCLFILE,SYMBUFP'*»2, SYMBLK)  <>  2  THEN 
BEGIN  CLOSE(INCLFILE) ;  INCLUDING  :=  FALSE; 
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SYM3LK  :=  oldsymblk;  symcursor  :=  oldsymcursor; 

LINESTAiU  :=  CLDLINESTART 

EfjD ; 

IF  -JOT  {INCLUDING  OR  USING)  THEN 

IF  3L0CKREAD(USLRlNFO.WQRKSYM'^,SY!i'!BUFP'"i2,SYiW|BLK)  <>  2  THEN 
ERROR(401)  ; 
IF  SYMCURSOR  =  0  THEN 

BEGIN 

if  inmodule  then 

if  inintekface  and  not  using  then  writetext; 
if  symbufp^coj  =  chr ( 16( *dle* ) )  then 
symcursor  :=  2 
end; 
symblk  :=  symblk+2 

END  (*GEtnEXTPAGE*)  ; 

(♦$!+*) 

PROCEDURE  PRINTLINE; 

VAR  DORLEVfSTARORC:  CHAR;  LENG:  INTEGER; 
a:  packed  ARRAY  CO. ,993  OF  CHAR; 

BEGIN  starorc  :=  •:»; 

IF  dp  then  DORLEV  •=  'D* 

ELSE  DORLEV  :=  CHR ( (BEGSTMTlEV  MOD  10)  +  ORD('OM); 

IF  BPTONLINE  THEN  STARORC  :=  •*•; 

WRITE(LP«SCREEND0TS:6»SEG:4,CURPR0C:5, 

STARORC, dorlev«lineinfo:6.»  '); 
leng  :=  symcursor-linestart5 
if  leng  >  100  then  leng  :=  100; 
moveleft(symbufp'*clinestart:»a,leng)  ; 
if  aco3  =  chr(16(*dle*))  then 

BEGIN 

IF  AC13  >  •  ♦  THEN 

^RITE(LP.'  •:0RD(AC13)-0RD('  ')); 
LENG  :=  LENG-2; 
M0VELEFT(A[:2J,A»LENG) 

End; 
acleng-ld  :=  chr(eol);  (*just  to  make  sure*) 
write{lp.a:leng) ; 
with  userinfo  00 

IF  (EKRBlK  =  SYMBLK)  AND  (ERRSYM  >  LINESTART)  THEN 


'^8-^7  10  ^-.6  03  WRIT£L;vI(LP.  •>>>>>>  ERROR  s  '.ERRNU^D 

"^823  IG  tt:o  b2  END  ( *PRi  NTLINE* )  ; 

^629  13  i+:o  &4  (*SI-*) 

'+830  10  4:o  64 

4831  13  5:D  1  PROCEDURE  ENTERIC ( *FCP :  CTP*); 

'+832  10  5:d  2  VAR  LCp,LCpi:  CTP;  i:  INTEGER; 

4833  10  5:o  0  BEGIN  LCP  :=  DISPLAYCT0P3.FNAME ; 

4834  10  5:i  3  IF  LCP  =  NIL  THEM  DISPLAYC ToPD.FMAME  :=  FCP 

4835  10  5:i  18  ELSE 

4836  10  b:2  22  3EGl!M  I  :=  TREESEARCH  (  LCP  ,  LCPl ,  FCP'^.  NAME  )  ; 
'+837  10  5:3  30  WHILE  I  =  0  DO 

^+838  10  5:4  35  BEGIN  ERROR(lOl); 

^+839  10  5:5  38  IF  LCPI'^.RLINK  =  NIL  THEN  I  :=  1 

aAu?  Jn  i:^  ^?  ^^^^  ^  ==  TR£ESEARCH(LCP1-.RLINK,LCPX»FCP-.NAME) 

fbti  10  5.4  56  END; 

Itli  J2  1:1  ^2  IF  I  =  1  THEN  LCPl-.RLINK  :=  FCP  ELSE  LCPl-.LLINK  :=  FCP 

4843  10  5:2  75  End; 

4844  10  5:1  77  FCP-.LLINK  :=  NIL;  FCP-.RLINK  :=  NIL 

^+845  10  5:0  85  END  (»ENTERID*)  5 

4846  10  5:0  02 

af!fl  ^°  ^'^  ^  PROCEDURE  INSYMBOL;  (♦  COMPILER  VERSION  3.4  06-NOV-76  *) 

4848  10  6:d  1  LABEL  1; 

'+849  10  6:d  1  VAR  LVP:  csp;  x:  integer; 

'+850  10  6:d  3 

'+851  10  21:d  1  PROCEDURE  CHECKEND; 

'+852  10  21:0  0  BEGIN  (*  CHECKS  FOR  THE  END  OF  THE  PAGE  *) 

4853  10  21:1  0  SCREENdoTS  :=  SCREENDOTS+15 

4854  10  21:1  6  SYMCURSOR  :=  SYMCUrSOR  +  i; 

4855  10  21:1  11  IF  NOISY  THEN 

4856  10  21:2  15  BEGIN  WRITE(OUTPUT . • . ♦ ) ; 

4857  10  21:3  23  IF  ( SCREENDOTS-STARTDOTS)  MOD  50  =  0  THEN 

4858  10  21:4  34  3e:GIN  WRITELN(0UTPUT  )  ; 

4859  10  21:5  40  WRITE(0UTPUT»»<».SCREEND0TS:4.t>f ) 

4860  10  21:4  65  END 

4861  10  21:2  65  end; 

'+862  10  21:1  65  IF  LIST  THEN  PRINTLINE; 

4863  10  21:1  71  BPTONLINE  :=  FALSE; 

4364  10  21:1  74  IF  SYMBUFP'^C  SYMCURsOK  3=CHR  (  0  )  THEN  GETnEXTPAGE 

4865  10  21:1  81  ELSE  LinESTART  :=  SYMCURSOR; 


IF  SYM3UFP-CSYMCURSOR3  =  CHR ( 12 ( *FF* ) )  THEN  SYMCURS0R;=SYMCURS0R+1 ; 


4866  10    21:1     88 

4867  10    21:1     00    IF  SYMBUFP-^CSYMCURSORD  =  CHR  ( 16  (  *OLE*)  )  "  THEN 
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SYMCJRSOR  : 
ELSE 
BEGIN 

SY^JICURSOR 

SY'JICURSOR 

end; 
if  dp  then  lineinfo 
end; 


=  SY'y|CUKS0R  +  2 


=  SYMCURSOR  +  SCArj{30»<>CHR(9),SYMBUFP'^i:SYI»'CURSOR]) 
=  SYMC;URSOR  +  SCArj(80»<>'  •  ♦  SYMBUFP'^C  SYMCURSOR  3  ) 


:=  LC  ELSE  LINEINFO  :=  IC 


PROCEDURE  CO,v|MENTER{STQPPER:  CHAR); 

VAR  ch.sw.oel:  char;  ltitle:  stringc40]; 

PROCEDURE  SCANSTRING(VAR  STRG:  STRING;  MAXLENG:  INTEGER); 

VAR  leng:  integer; 

BEGIN  SYMCURSOR  :=  SYMCURSOR+2; 

LENG  :=  SCAN{MAXLENGf=ST0PPERtSYMBUFP'*CSYMCURS0R3)  ; 

STRGC03  :=  CHRCLENG) ; 

M0VElEFT(SYMBUFP'^CSYMCURS0RD,STRGC13,LENG); 

SYMCURSOR  :=  SYMCURSOR+LENG+1 
END  (♦SCANSTRING*)  ; 

BEGIN 

SYMCURSOR  :=  SYMCURSOR+i;  (*  POINT  TO  THE  FIRST  CH  PAST  "<♦"  *) 
IF  SYM3UFP'*CSY!«ICURS0R]=«$'  THEN 

IF  SYMBUFP'^CSY^cURSOR  +  l]  <>  STOPPER  THEN 
REPEAT 

CH  :=  symbufp'*csymcursor+id; 

SW  :=  SYMBUFP'"CSYMCURS0R+23; 

DEL  :=  symbufp'*csymcursor+3d; 

IF  (SW  =  •,•)  or  (SW  =  STOPPER)  THEN 
BEGIN  DEL  :=  SW;  SW  :=  •+•; 
SYMCURSOR  :=  symcursor-1 
end; 

CASE  CH  OF   . 

BEGIN 

if  level  >  1  then  err0r(194); 

new(comment) ;  scanstring ( comment" » 80 ) 
end; 

de3ugging  :=  (sw=»+«); 
flipbytes  :=  (sw='+'); 
GOTOOK  :=  (Sw='+»); 
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EXIT(COMMENTER) 
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27 

4941 
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37 

4942 
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43 

4943 

10 

22:6 

47 
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IF  (S/i'='  +  ')  OR  (Sw='-M  THEN  lOCHECK  :=  (SW=»  +  ') 
ELSE 

BEGIfJ  SCANSTRING(LTITLE,40)  ; 
IF  STOPPER  =  '*•  THEN 

SYMCURSOR  :=  SYMCURSOR+l; 
IF  LIST  THEN 
BEGI.J 

SYMCURSOR  :=  SYMCURSOR  +  i; 
PRINTLINE; 

SYMCURSOR  :=  SYMCURSOR  -  i; 
END; 
IF  INCLUDING  OR  INMODULE  AND  ININTERFACE  THEN 

BEGIN  ERROR(406);  EXITCCQMMENTER)  END; 
OPENOLD(INCLFILE.LTITLE); 
IF  lORESULT  0  0  THEN 

BEGIN  OPENOLD(INCLFlLEfCONCAT(LTlTLE.'.TEXT»)); 

IF  lORESULT  0  0  THEN  ERROR(403) 
END; 

INCLUDING  :s  true; 

OLDSYMCURSOR  :=  SYMCURSOR; 

OLDLINESTART  :=  LINESTART; 

OLDSYMBLK  :=  SYMBLK-2; 

SYMBLK  :=  2;  GETNEXTPAGE; 

INSYMBOL;  EXITdNSYMBOL) 
END; 
IF  (SW=»  +  M  OR  (SW=«-')  THEN 
BEGIN  LIST  :=  (SW=»+« ) ; 

IF  LIST  THEN  OPENNEW( LP* •♦SYSTEM. LST, TEXT* ) 
END 
ELSE 

BEGIN  SCANSTRING(LTITLE,40); 

OPENNEW(LP,LTITLE); 

LIST  :=  lORESULT  =  0; 

EXIT(COMMENTER) 
END; 

NOISY  :=  (sw=»-»); 

WRITE(LP»CHR(12(*FF*))) ; 
RANGECHECK  :=  (SW=»  +  M; 
NOSWAP:  =  (SW='-M  ; 

TINY  :=  (sw=«+«); 

IF  (SW='  +  M  OR  (Si«l=»-M  THEN 
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BEGIN  SYSCOMF  :=  (SW  =  •-•  )  ; 
rtANGECflECK  :=  NOT  SYSCOMP; 
lOCHECK  :=  RflNGECHECK; 
GOTOOK  :=  SYSCONiP 
Ei'«JO 
ELSE 

IF  NOT  USING  THEN 

BEGIN  SCANST^ING(SYSTEMLIB,40) 5 

CL0SE(LI3RARY);  LIBNOTOPEN  :=  TRUE; 
EXIT(C0MS/1ENTER) 
END 
END  (*CASES*J5 
SYWCURSOR  :=  SYMCURSOR+3; 
UNTIL  DEL  <>  •♦•; 
SYMCURSOR  :=  SYMCURSOR-i;  (*  ADJUST  *) 
REPEAT 
REPEAT 

SYvicURSOR  :=  SYMCURSOR  +  i; 

WHILE  SYM3UFP'^LSYMCURS0R3  =  CHR(EOL)  DO  CHECKEND 
UNTIL  SYMBUFP'^C SYMCURSOR 3=ST0PPER; 
UNTIL  (SYM3UFP'*CSYMCURS0R+i:=M»)  OR  ( STOPPER=»  !•  )  ; 
SYMCURSOR  :=  SYMCURSOR+i; 
END  (*CO,viviENTER*)  ! 

PROCEDURE  STRING; 

LABEL  1; 

VAR 

T:  PACKED  ARRAY  Cl.,80J  OF  CHAR; 

tp,nblanks,l:  integer; 
duple:  boolean; 

BEGIN 

DUPLE  :=  FALSE;  (*  INDICATES  WHEN  '•  IS  PRESENT  ♦) 
TP  :=  0;  (*  INDEX  INTO  TEMPORARY  STRING  *) 
REPEAT 

IF  DUPLE  THEN  SYMCURSOR  :=  SYMCURSOR+i; 
REPEAT 

SYMCURSOR  :=  SYMCURSOR+i; 

TP  :=  TP+i; 

IF  SYMBUFP'^CSYMCURSORJ  =  CHR(EOL)  THEN 
3ESIN  ERROR(202);  CHECKEND;  GOTO  1  END; 
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42 

tctp:  :=  symsufp^csymcursord; 

4992 

IC 

24:2 

b2 

UrgTiL  SY.*1BUFP''C,SY*^t:URS0R3=»  ♦  •  •  ; 

frgso 

ll 

24:? 

b9 

DUPLE  :=  TRUi:.; 

499^+ 

10 

2^+11 

fa2 

UNTIL  SYMBUFP'^CSYrJlcUKSOR  +  mO*  •  •  •  ; 

1995 

IG 

24:i 

71 

i:   TP  :=  TP-U  (*  ADJUST  *) 

4996 

10 

24:i 

77 

SY  :=  STRINGCOIMST;  OP  :=  NOOP; 

4997 

10 

24:i 

83 

LGTH  :=  TP;  (*  GROSS  *) 

4998 
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IF  TP=1  (*  SINGLE  CHARACTER  CONSTANT  *) 

4999 
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24:i 

S9 

THEN 
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93 

VAL.IVAL  :=  ORD(TCID) 
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ELSE 

5002 

10 

24:2 

03 

^IJH    SCONST-"  DO 
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3EGIN 
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CCLASS  :=  STRG; 
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SLGTH  :=  Tp; 
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MOVELEFT(TCi:].SVALClD,TP); 
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VAL.VALP  :=  SCONST 
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END(*STRING*); 
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PROCEDURE  NUMBER; 
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VAR 
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EXPONENT »ENDIfENDF,ENDE, SIGN tIPART»FPART,EPARTf 
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ISUm:   INTEGER; 
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TIPE:  (REALTIPEilNTEGERTIPE); 
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RSUm:  real; 
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notlong:  boolean; 
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K.J:  Integer; 
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BEGIN 
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(*  TAKES  A  NUMBER  AND  DECIDES  WHETHER  IT'S  REAL 
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OR  INTEGER  AND  CONVERTS  IT  TO  THE  INTERNAL 
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FORM.  *) 
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TIPE  :=  integertipe; 
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ENDi  :=  o; 
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ENDF  :=  o; 
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ENDE  :=  o; 
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12 

SIGN  :=  i; 
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15 

NOTLONG  :=  TRUE; 
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13 

EPART  :=  9999;  (*  OUT  OF  REACH  *) 

5030 

10 

25:i 

23 

IPART  :=  SYMCURSOR;  (*  INTEGER  PART  STARTS  HERE  *) 
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REPEAT 
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25:3 

29 

5057 

10 

25;i 

33 

5058 

10 
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5060 
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41 
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SYMCJRSOR  :=  SY;MCUKS0R  +  1 
imill     (srMbUF^'"CSYMCURSORD<'0' )  OR  (SYMBUFP'^CSYMCURS0R3>'9' )  ; 
(*  SY^cuRSOP  NOW  POINTS  AT  FIRST  CHARACTER  PAST  INTEGER  PART  *) 
ENDI  :=  SYiV;CURSQR-i;  (*  MARK  THE  END  OF  IPART  *) 
IF  SY'M^,JFP^CSYMCURS0R3='  .  • 
Ti^EN 

IF  SYMSUFP'^CSYO^CURSOR  +  130'.  •   (*  WATCH  OUT  FOR  •..♦  *) 
THEN 
BEGIN 

TiPE  :=  realtipe; 

SYMCURSOR  :=  SYMCURSOR+l; 

FPART  :=  SYMCURSOR;  (*  BEGINNING  OF  FPART  ♦) 
WHILE  (SYMBUFP'^CSYMCURSOR:  >=  'OM  AND 
(SYMBUFP'^CSYMCURSORJ  <=  *S*)    DO 
SYMCURSOR  :=  SYMCURSOR+i; 
IF  SYMCURSOR  =  FPART  THEN  ERROR{20l); 
ENDF  :=  sYMCURSOR-15 
END; 
IF  SYMbUFP'^CSYMCURsOR3=»E» 
THEN 
BEGIN 

TIPE  :=  REALTIPE; 
SYMCURSOR  :=  SYMCURSOR+15 
IF  SYMBUFP'*CSYMCURSORD='-« 
THEN 
BEGIN 

SYMCURSOR  :=  SYMCURSOR+i; 

SIGN  :=  -1; 

END 
ELSE 

IF  symbufp''csymcursor:=»  +  ' 

THEN 

SYMCURisOR  :=  SYNlCURSOR  +  1; 
EPART  :~  SYpjicURSOR;  (*  BEGINNING  OF  EXPONENT  *) 
^HILE  {SYMBUFP"CSYMCURS0R3>='0» I  AND  ( SYMBUFP^C SYMCURSOR ]<=' 9 ' )  DO 

SYMCURSOR  :=  SYMCURSOR+l; 
ENDE  :=  SYMCURSOR-l; 

IF  EN0E<:EPART  then  ERROR(201);  i*  ERROR  IN  REAL  CONSTANT  ♦} 
ENj; 
(*  NOW  CONVERT  TO  INTERNAL  FORM  *) 

IF   ti^e=intege;rtipe  then 
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43 

5099 
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54 

5100 
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57 
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57 
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60 

5103 
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25:9 

71 

5104 
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25:6 

77 

5105 

10 

25:7 

83 
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25:7 

88 

5107 

10 

25:8 

93 
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10 

25:9 

01 
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25:8 

10 
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12 

5111 
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12 
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18 

5113 
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25 

BEGI.>j 

ISJ^^  :=  0; 

FOR  J  :=  IPART  TO  ENDI  DO 
BEGIN 

IF  (ISUM>MAXINT  DIV  10)  OR  (  (ISUM=|v/IAXlrjT  DIV  10)  AND 

orrxM   ^ipRD(SYMBUFP-CJ])  -  ORDCOM  >  MAXINT  MOD  10))  THEN 
BEGIN  NOTLONG  :=  FALSE;  K  :=  J;  j  ;=  enqI  END 

ELSE  ISUM  :=  ISUM*10+(ORD{SYMBUFP'*CJ3)-ORD(  •0»  )  )  : 

END; 

IF  NOTLONG  THEN 
BEGIN 

SY  :=  intconst;  op  :=  noop; 
VAL.IVAL  :=  isum; 
END 
ELSE 
BEGIN 

IF  ENDI  -  IPART  >=  MAXDEC  THEN 

BEGIN  ERROR(203);  IPART  :=  ENDI;  K  :=  ENDI  END; 
NEW(L\/P,L0NG); 
WITH  LVP'^  DO 

BEGIN  CCLASS  :=  LONG;  J  :=  4;  LLENG  :=  o; 
WHILE  K  <=  ENDI  00 
BEGIN 

IF  J  =  4  THEN 

BEGIN  LLENG  :=  LLENG  +  i; 
LONGVALCLLENGD  Ir  ISUM; 

ISUM  :=  0; 
J  :=  0 
END; 

ISUM  :=  ISUM  *  10  +  0RD(SYMBUFP'^CKD)-ORD{»0»); 
K  J=  K  +  1;  J  :=  J  +  1 
end; 
LLAST  :=  j; 

IF  J  >  0  THEN 

BEGIN  LLENG  :=  LLENG  +  i; 

longvalcllengd  :=  isum 
end; 
end; 
SY  :=  LONGCONsT;  OP  :=  noop; 

LGTH  :=  ENDI  -  IPART  +  i; 

val.valp  :=  LVP 
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25:4    25  end; 

25:2    io  e^jd  (*tipe  =  inte  gertipe* ) 

25:i            30  ELSE 

25:2            j2  begin     (*    REAL    NUMBER    fiERE    *) 

25:3            32  RSJM    :=    0: 

38  FOR  J  :=  IPART  TO  ErjDI  DO 

49  3EGIN 

49  RSUM  :=  RSUM*10+(ORD(SYM3UFP''CJD)-ORD( 'O' )  )  5 

67  r^Q; 

74  FOR  J  :=  ENDF  QOWNTO  FPART  DO 

85  RSUM  :=  RSUM+(ORD(SYMBUFP'*[:j3)-ORD('0')  )/PWROFTEN{J-FPART  +  l)  ; 

15  EXPONENT  :=  0; 

18  FOR  J  :=  EPART  TO  ENDE  DO 

29  EXPONENT  :=  EXPONENT*10  +  ORD  (  SYMBUFP'^C  J3  ) -ORD(  •  0  •  )  5 

47  IF  SlGN=-l  THEN 

53  RsUM  :=  RSUM/PWROFTEN(EXPONENT) 

60  ELSE 

67  RSUM    :=    RSUM*PWROFTEN(EXPOr\tENT)  ; 

79  SY  :=  realconst;  op  :=  noop; 

85  NEw(LVPtREEL) 5 

91  LVP^.CCLASS  :=  REEL; 

96  LVP'^.RVAL  :=  RSUMJ 

07  val.valp  :=  Lvp; 

12  End; 

12  symcursor  :=  symcursor-i;  (*  adjust  for  posterity  *) 

17  end  (♦number*)  ! 

52 

0  BEGIN  (*  iNSYMBOL  *) 

0  IF  GETSTMTLEV  THEN  BEGIN  BEGSTMTLEV  :=  STMTLEV;  GETSTMTLEV  :=  FALSE  END; 
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25 
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25 

25 

25 

25 

25:3 

25:4 

25:3 

25:4 

25:3 

25:4 
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25:3 

25:3 

25:3 

25:2 

25:1 

25:0 
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6:0 

6:1 

6:1 

6:1 


6! 

6: 
6: 


6:2 
6:1 
6:1 
6:1 
6:1 
6:2 
6:1 


11 


OP 


=  NOOP; 

14    1:       SY    :=    OTHERSY;     (*    if    no    cases    exercised    BLOW    UP    *) 
17         CASE    Syi«IBUFP'^CSYMCURS0R3    OF 

:STRlN6i 


22 

26 
26 
30 
30 
30 
30 
30 
37 


•  If 

•  0» 

•A» 

•N' 
•A' 

•N* 


»1»,«2» 

NUi^BER 
•B» , 'C* 
•0',»P« 
'3'  ,  'C* 
•0« , 'P» 


•3«. '4'. •5»,»6','7' 


8»t»9«: 


,'F»,»G', 

,»S',  •TN'US  •V'l'W 

,  'F*  ,  •G','H»,  'IN'J'i'KN'L' 


•K»»»l 
•X» t»Y« 


•M'  , 


•!«l»  , 


IDSEARCH(SYMCURS0R,SYMBUFP'^)  ;     (*    MAGIC    PROC    *) 
BEGIN    COMMENTER  <•:]•)  ;    GOTO    1    END; 


5155 

bl5a 

5157 

5158 

515i 

5160 

5161 

5162 

5163 

5164 

5165 

5166 

5167 

5168 

5169 

5170 

5171 

5172 

5173 

517«f 

5175 

5176 

5177 

5178 

5179 

5180 

5181 

5182 

5183 

5181+ 

5185 

5186 

5187 

5188 

5189 

5190 

5191 

5192 

5193 

519^+ 

5195 


10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 


o  .  1 

o ;  .3 
6: '4 

6:5 
6:5 
6:5 

614 

6:3 

6:4 

6:2 

6:1 

6;i 

6:i 

6:1 

6:3 

6:3 

6:4 

6:5 

6:5 

6:4 

6:3 

6;<* 

6:2 

6:1 

6:2 

6:3 

6:f 

6:t+ 

6:3 

6:2 

6:3 

6:1 

6:1 

6:1 

6:1 

6:1 

6:1 

6:1 

6:1 

6:1 


53 

5o 

53 

61 

66 

69 

68 

70 

73 

75 

60 

85 

9«+ 

9*+ 

99 

03 

03 

08 

08 

11 

13 

16 

18 

23 

27 

27 

32 

35 

35 

37 

42 

47 

52 

57 

62 

70 

78 

86 

94 


THEN 


•)  • 

•♦♦ 
f  t 


»  ?  t 


♦*• 

•  +  • 
t .  t 

•/• 


♦  ) 


:  BEGIN 

IF  SYMBUFP'^CSYMCJRS0R  +  13='*' 
[3EGIN 

SYMCURSOR  :=  SYMCURSOR+l; 
COMiV|ENTER(  ♦*•  )  ; 
SYi^lCURyOR  :=  SYvicURSOR  +  1; 
GOTO  1;  (♦  GET  ANOTHER  TOKEN 
END 
ELSE 

SY  :=  lpakent; 
End; 

SY  :=  RPARENT; 

SY  :=  comma; 

♦  ':  BEGIN  SYMCURSOR  :=  SYMCURSOR+l;  GOTO 

Begin 
if  symbufp'»[:symcurs0r  +  1d=»,» 

THEN 
BEGIN 

SYMCURSOR  :=  SYMCURSOR+l; 
SY  :=  COLON 
END 
ELSE 

sy  :=  period; 

End; 

If  SYMBUFP'"CSYMCURS0R  +  13r»  =  » 
THEN 
BEGIN 

SYMCURSOR  :=  SYMCURSOR+l; 

SY  :=  becomes; 

END 
ELSE 

SY  :=  colon; 

SY  :=  semicolon; 
SY  :=  arrow; 
SY  :=  lbrack; 
sy  :=  RBRACK; 
Begin  sy  :=  mulop; 
begin  sy  :=  ADDOP; 
Begin  sy  :=  addop; 
Begin  sy  :=  mulup? 

BEGIN 


end; 


op 
op 

OP 

op 


MUL  END; 
PLUS  END; 
MINUS  END; 
RDIV  END; 


453 


1G4 


5196 

10 

6:3 

94 

SY  :=  RELOP; 

5197 

IC 

613 

97 

OP  :=  LTOP; 

5198 

10 

613 

00 

CASE  SYMBUFP'^CSYMCURSOR  +  IJ  OF 

5199 

ID 

6:3 

J7 

'>•:  BEGIN 

5200 

10 

6:5 

0  7 

OP  :=  NEOp; 

5201 

10 

6:5 

10 

SYFCURSQR  :=  SYMCURSOR+1 

5202 

10 

6:4 

11 

END; 

5203 

10 

6:3 

17 

•=•:  3EGIN 

5204 

10 

6:5 

17 

OP  :=  LEOp; 

5205 

10 

6:5 

20 

SYMCURSOR  :=  SYMCURSOR+1 

5206 

10 

6:4 

21 

END 

5207 

10 

6:3 

25 

.  END; 

5208 

10 

6:2 

38 

End; 

52G9 

10 

6:i 

40 

•=•:  BEGIN  SY  :=  RELOP5  OP  :=  eqop  end; 

5210 

10 

6:i 

48 

'>•:  BEGIN 

5211 

10 

6:3 

48 

SY  :=  RELOP; 

5212 

10 

6:3 

51 

IF  SYM8UFP^CSYMCURS0R+13='=» 

5213 

10 

6:3 

56 

THEN 

52m 

10 

6:4 

60 

BEGIN 

5215 

10 

6:5 

60 

OP  :=  GEOP; 

5216 

10 

6:5 

63 

symcursor  :=  symcursor+i; 

5217 

10 

6:4 

68 

END 

5218 

10 

6:3 

68 

ELSE 

5219 

10 

6:4 

70 

OP  :=  GTOP; 

5220 

10 

6:2 

73 

END 

5221 

10 

6:1 

73 

END  (♦  CASE  SYMBUFP'^CSYMCURSOR]  OF  *); 

5222 

10 

6:1 

12 

IF  sy=othersy  then 

5223 

10 

6:2 

17 

IF  symbufp'^csymcursord  =  chr(eol)  then 

5224 

10 

6:3 

24 

BEGIN  CHECKEND;  GETsTMTLEV  :=  TRUE;  GOTO 

5225 

10 

6:2 

31 

ELSE  ERROR{400) ; 

5226 

10 

6:1 

38 

symcursor  :=  SYMCURSOR+i;  (*  NEXT  CALL  TALKS 

5227 

10 

6:0 

43 

END  (*insymbol*)  ; 

5228 

10 

6:0 

62 

5229 

10 

6:0 

62 

5230 

10 

6:0 

62 

(*$I  #5:PR0CS.A.TEXT*) 

5230 

10 

6:0 

62 

(♦$1  t»5:PR0CS.B.TEXT*) 

5231 

10 

6:0 

62 

{*       COPYRIGHT   (C)  1979,  REGENTS  OF  THE 

5232 

10 

6:0 

62 

(*       UNIVERSITY  OF  CALIFOR^JIA,  SAN  DIEGO 

5233 

10 

6:0 

62 

5234 

10 

7:d 

1 

PROCEDURE  SEARCHSECTI0N{*FCP:  CTP;  VAR  FCPl: 

5235 

10 

7:0 

0 

BEGIN 

1  END 

ABOUT  NEXT  TOKEN  *) 


*) 
♦  ) 


CTP*) 


5236 

10 

7:i 

0 

5237 

10 

7:^ 

5 

5238 

10 

112 

15 

5239 

ID 

111 

18 

O24-0 

lu 

7:o 

<23 

52*11 

10 

7:o 

38 

52^+2 

10 

8:u 

1 

52'+3 

10 

8:o 

3 

52'^'+ 

10 

8:o 

0 

52«+5 

10 

8:i 

0 

5246 

10 

8:2 

12 

52«+7 

10 

8:3 

21 

5216 

10 

8:4 

26 

5249 

10 

8:5 

37 

5250 

10 

8:5 

47 

5251 

10 

8:6 

49 

5252 

10 

8:6 

54 

5253 

10 

8:4 

58 

5254 

10 

8:2 

63 

5255 

10 

8:i 

74 

5256 

10 

8:2 

78 

5257 

10 

8:3 

81 

5258 

10 

8:3 

87 

5259 

10 

8:4 

93 

5260 

10 

8:4 

99 

5261 

10 

8:5 

05 

5262 

10 

8:5 

11 

5263 

10 

8:6 

17 

5264 

10 

8:6 

23 

5265 

10 

8:7 

29 

5266 

10 

8:7 

35 

5267 

10 

8:2 

41 

5268 

10 

8:1 

45 

5269 

10 

8:0 

46 

5270 

10 

8:0 

62 

5271 

10 

9:d 

1 

5272 

10 

9:0 

0 

5273 

10 

9:1 

0 

5274 

10 

9:2 

3 

5275 

10 

9:3 

9 

5276 

10 

9:2 

17 

IF  FCP  0  NIL  THEN 

IF  TREESEARCH(FCP,FCP1.ID)  =  0  THEN  (*NADA*) 
ELSE  FCPl  :=  NIL 
ELSE  FCPl  :=  NIL 
END  (*SEARCHSECTION*)  ; 

PROCEDURE  SEARCHID(*FIDCLS:  SETOFJDS;  VAR  FCP:  CTP*); 

LABEL  1;  VAR  LCP;  CTP; 
BEGIN 

FOR  DISX  :=  TOP  DOWNTO  0  DO 

BEGIN  LCP  :=  displaycdisxd.fname; 

IF  LCP  <>  NIL  THEN 

IF  TREESEARCH(LCPtLCP»ID)  =  0  THEN 
IF  LCP-^.KLASS  IN  FIOCLS  THEN  GOTO  1 
ELSE 

IF  PRTERR  THEN  ERROR(103) 
ELSE  LcP  :=  NIL 
ELSE  LCP  :=  NIL 
END; 
IF  PRTERR  THEN 

BEGIN  ERROR(104) ! 

IF  TYPES  IN  FIDCLS  THEN  LCP  :=  UTYPPTR 
ELSE 

IF  ACTUALVARS  I|\j  FiDCLS  THEN  LCP  :=  UVARPTR 

IF  FIELD  IN  FIDCLS  THEN  LCP  :=  UFLDPTR 
ELSE 

IF  KONST  IN  FIDCLS  THEN  LCP  :=  UCSTPTR 
ELSE 

IF  PROC  IN  FIDCLS  THEN  LCP  :=  UPRCPTR 
ELSE  LCP  :=  UFCTPTR 
END; 
'*5  1:   FCP  :=  LCP 

END  (*SEARCHID*)  ; 

PROCEDURE  GETBOUNDS(*FSp:  STP;  VAR  FMIN,FMAX:  INTEGER*); 

WITH  FSP**  00 

IF  FORM  =  SUBRANGE  THEN 

BEGIN  FMIN  :=  MIN.IVAL5  FMAX  :=  MAX.IVAL  END 

ELSE 
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5277 

10 

9:3 

19 

d27S 

IC 

9:4 

22 

5279 

10 

9:4 

29 

b280 

10 

9:5 

i5 

5281 

10 

9:6 

41 

5282 

10 

9:5 

44 

5283 

10 

9:3 

50 

'528'+ 

10 

9:o 

52 

5285 

10 

910 

64 

5286 

10 

io:d 

1 

5287 

10 

io:o 

0 

5288 

10 

io:o 

10 

5289 

10 

10  :o 

28 

5290 

10 

ii:d 

3 

5291 

10 

ii:o 

0 

5292 

10 

ii:i 

3 

5293 

10 

11:2 

8 

5294 

10 

11:3 

14 

5295 

10 

11:0 

21 

5296 

10 

11:0 

36 

5297 

10 

12;d 

3 

5298 

10 

12:0 

0 

5299 

10 

12:1 

3 

5300 

10 

12:0 

11 

5301 

10 

12:0 

26 

5302 

10 

13:d 

3 

5303 

10 

i3:o 

0 

5304 

10 

i3:o 

5 

5305 

10 

13:0 

5 

5306 

10 

13:0 

22 

5307 

10 

14:d 

1 

5308 

10 

14:0 

7 

5309 

10 

14:d 

10 

5310 

10 

i4:o 

0 

5311 

10 

14:1 

6 

5312 

10 

14:2 

16 

5313 

10 

i4:i 

34 

5314 

10 

14:2 

43 

5315 

10 

14:3 

43 

5316 

10 

14:4 

48 

5317 

10 

14:5 

48 

3EGirj  F^^IN  :=  0; 

IF  ^SP    -    CHAKPTR  THEN  FMAX  :=  255 
ELSE 

IF  FSP'^.FCONST  <>  NIL  THEN 

FMAX  :=  FSP'^.FCONST'^. VALUES. IVAL 
ELSE  FMAX  :=  Q 
END 
END  (*GETBOUNDS*)  ; 

PROCEDURE  SKIP(*FSYS:  SETOFSYS*)! 
BEGIN  WHILE  NOT(SY  IN  FSYS)  DO  INSYMBOL 
END  (*SKIP*)  '" 

FUNCTION  paofchar(*fsp:  stp):  boolean*); 

BEGIN  PAOFCHAR  :=  FALSE; 
IF  FSP  <>  NIL  THEN 

IF  FSP'^.FORM  =  ARRAYS  THEN 

PAOFCHAR  :=  FSP'^.AISPACKD  AND  (FSP'^.AELTYPE  =  CHARPTR) 
END  (*PA0FCHAR*)  ; 

FUNCTION  STRGTYPE{*FSP:  STP)  :  BOOLEAN*); 
BEGIN  STRGTYPE  :=  FALSE; 

IF  PAOFCHAR(FSP)  then  STRGTYPE  :=  FSP'^.AISSTrNG 
END  (*STRGTYPE*)  ; 

FUNCTION  DECSIZE(*i:  INTEGER):  INTEGER*); 

BEGIN  DECSIZE  :=  ( I  +  3)  DIV  4  +  1  (*GROSS, .MAXIMUM  NEEDED  SPACE*) 

(*  BINARY  FN.  SHOULD  BE  ((1*332)  DIV  100  +  1  +  BITSPERWO)  DIV  BITSPERWD  *) 

END  (*DECSI2E*)  \ 

PROCEDURE  C0NSTANT{*FSYS:  SETOFSYS;  VAR  FSP:  STP;  VAR  fvalu:  valu*); 

VAR  lsp:  stp;  lcp:  ctp;  sign:  (none.pos,neg)  ; 
lvp:  csp; 
begin  lsp  :=  nil!  fvalu, ival  :=  0; 
if  not(sy  in  constbegsys)  then 

BEGIN  ERROR(50);  SKIP( FSYS+CONSTBEGSYS)  END; 
if  Sy  IN  CONSTBEGSYS  THEN 
BEGIN 

if  sy  =  stringconstsy  then 

BEGIN 

IF  LGTH  =  1  THEN  LSP  :=  CHARPTR 


5316 

5319 

5320 

5321 

5322 

5323 

532^ 

5325 

5326 

5327 

5323 

5329 

5330 

5331 

5332 

5333 

5334 

5335 

5336 

5337 

5338 

5339 

53fO 

53fl 

5342 

5343 

5344 

5345 

5346 

5347 

5343 

5349 

5350 

5351 

5352 

5353 

5354 

5355 

5356 

5357 

5358 


iO 

m 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 


14 

14 

14 

14 

14 

14 

14 

14 

14 

14 

14; 

I4i 
14! 
14:4 
14:5 

14:5 

14:6 

14:7 

14:6 

14:5 

14:6 

14:7 

14:8 

14:7 

14:8 

14:9 

i4:i 

14:8 

14:9 

i4:o 

14  :i 

1*^:2 

14:3 

14:3 

14:3 

14:2 

i4:o 

14:9 

14  :o 

i4:i 

14:2 


:? 
;? 

;7 

7 
7 
7 

7 
6 
5 
4 
3 


b4 

bO 

faO 

65 

7  0 

76 

61 

88 

94 

94 

97 

02 

04 

06 

06 

09 

20 

34 

34 

36 

41 

49 

52 

62 

67 

72 

77 

82 

84 

90 

90 

95 

00 

03 

15 

18 

13 

18 

20 

29 

29 


else: 

BEGIN 

NEkJ(LSPf  AKRAYStTRUEiTRUE)  ; 
LSP-^  :=  STRGPTR'^J 

LSP'^.MAXLENG  :=  LGTH; 
LSP^.IIMXTYPE  :=  iMIL; 
NEWCLVP) ; 

LVP-  :=  VAL.VALP'^; 
VAL.VALP  :=  LVP 
END; 
FVALU  :=  VAL;  INSYM30L 
END 
ELSE 
BEGIN 

SIGN  :=  NONE; 

IF  (SY  =  ADDOP)  AND  (OP  IN  CPLUS,MINUS3)  THFN 

'"Nsr^BOu'  '-   ''"'  '"'"  '''"   ==  ^°""lsJ"Iign  :=  ne3, 

end; 

IF  SY  =  IDENT  THEN 

BEGIN  SEARCHlD{CK0NST3fLCP) J 
WITH  LCP*^  DO 

BEGIN  LSP  :=  IDTYPE;  FVALU  :r  VALUES  END; 
IF  SIGN  <>  NONE  THEN 
IF  LSP  =  INTPTR  THEN 

BEGIN  IF  SIGN  =  NEG  THEN 
^    FVALU. IVAL  :=  -FVALU. IVAL  END 

IF  LSP  =  REALPTR  THEN 
BEGIN 

IF  SIGN  =  NEG  THEN 
BEGIN  NEW(LVP.REEL); 

LvP'^.ccLASs  :=  reel; 

LVP-.RVAL  :=  -FVALU. valp*.rval; 
FVALU. VALP  :=  LVP; 
END 
END 
ELSE 

IF  COMPTYPES(LSP,LONGINTPTR)  THEN 
BEGIN 

IF  SIGN  =  NEG  THEN 
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5359 

10 

mis 

34 

5360 

10 

m:^ 

39 

5361 

10 

mi^ 

42 

5362 

10 

14:4 

62 

5363 

10 

14:3 

S3 

5361+ 

10 

14:1 

65 

5365 

10 

i4:o 

b5 

5366 

10 

14:7 

70 

5367 

10 

14:6 

72 

5368 

10 

14:5 

72 

5369 

10 

14:6 

74 

5370 

10 

14:7 

79 

5371 

10 

i4:a 

39 

5372 

10 

14:7 

97 

5373 

10 

14:6 

99 

537*+ 

10 

14:7 

01 

5375 

10 

14:8 

06 

5376 

10 

i4:o 

11 

5377 

10 

14:9 

24 

5378 

10 

14:8 

33 

5379 

10 

14:7 

35 

5380 

10 

14:8 

37 

5381 

10 

14:9 

42 

5382 

10 

i4:o 

42 

5383 

10 

i4:i 

47 

5384 

10 

14:2 

68 

5385 

10 

14:2 

73 

5386 

10 

14:2 

81 

5387 

10 

14:2 

86 

5388 

10 

14:2 

91 

5389 

10 

i4:i 

91 

5390 

10 

14:9 

93 

5391 

10 

14:8 

93 

5392 

10 

14:9 

95 

5393 

10 

14:4 

07 

539^ 

10 

14:3 

07 

5395 

10 

14:4 

17 

5396 

10 

14:2 

29 

5397 

10 

i4:i 

29 

5398 

10 

i4:o 

30 

5399 

10 

i4:o 

52 

tJEGIN    NEW  (LVPt  LONG)  ? 

LVP'^.CCLASs  :=  long; 

LVP'^.LONGVALCl]  :=  -  FVALU  .  VALP'*  .LONGVALCl  3  5 
FVALU.VALP  :=  LVP 
END 
END 
ELSE  ERRORdOS)  ; 
INSYMB0L5 
END 
ELSE 

IF  SY  =  INTCONST  THEN 

BEGIN  IF  SIGN  =  NEG  THEN  VAL.IVAL  :=  -VAL.IVAL; 

Lsp  :=  intptr;  fvalu  :=  val;  insymbol 

END 
ELSE 

IF  SY  =  REALCONST  THEN 

begin  if  sign  =  neg  then 

val.valp'^.rval  :=  -val.valp^.rval; 
LSP  :=  realptr;  fvalu  :=  val;  insymbol 

END 
ELSE 

IF  SY  =  LONGCONST  THEN 
BEGIN 

IF  SIGN  =  NEG  THEN 

BEGIN  VAL.VALP-^.LONGVALCID  :=  -  VAL, VALP'^.LONGVALCID; 
NEW(LSPiLONGINT) ! 
LSP". SIZE  :=  DECSIZECLGTH); 

LSP'^.FORM  :=  longint; 
FVALU  :=  val; 

INSYMBOL 
END 
END 
ELSE 

begin  error(106);  skip(fsys)  end 

end; 
if  not  (sy  in  fsys)  then 
begin  err0r(6);  skip{fsys)  end 

END; 
FSP  :=  LSP 

END  (*C0NSTANT*)  ; 


s!!n?  In  J^i"  i  ''^f^CTlDM    C0MPTYPES(*FSP1,FSP2:     STP)     :    BOOLEAN*); 

suni  ir  ?^:^'  !  ^'^^  :^jxti,nxt2:  ctp;  cump:  boolean; 

3HU^  10  Ib.O  3  LTESTP1,LTESTP2    :    TESTP; 

5f03  10  15:q  Q  rjEGlN 

-HS^  ?5  ^^'^  °  ^"^    ^SPl    =    FSP2    THEN    COMRTYPES    :=    TRUE 

o'+UD  10  Ib.i  5  ELSE 

^^S?  II  IV:?_  19  ELse''^''^    "    '^^'■'    ^"^    ^^^^^    "    '^^^^^    ^^^^^    COMRTYPES    :=    TRUE 

nil  Jn  Isif  ^?  ^'^    FSPl-.FORM    =    FSP2%F0RM    THEN 

=  ,  ;;  °  ^'^  ^^  CASE    FSPl-.FORM    OF 

S'^io  10  15:^  35  scalar: 

ll^l  Jn  }V^  ^^  COMRTYPES  :=  false; 

5412  10  15:^  40  subrange: 

5414  in  iV'l  11  COMPTYPES  :=  C0MPTYPES{FSP1«.RANGETYPE, 

5415  10  15:4  52  ..,..cn.  FSP2-.RANGETYPE) ; 


5416   10    15:5     52 


POINTER: 
BEGIN 


54II  is  il't  II  PS^M^  ^"^^^'^    LTESTPl  :=  GLOBTESTP; 

5419  10  15-A  II  LTESTP2  :=  GLOBTESTP; 

5420  is  ii.*7  tl  ""^"-^  LTESTPl  <>  NIL  DO 
llp^  iS  i^:!  5?  WITH  LTESTPl-  DO 

5421  10  15:8  71  BEGIN 

5423  iS  IV'l  II  ^^    '^"-^^  =  FSPl-.ELTYPE)  AND 

5424  10  15-9  87  ^^^"^^  =  FSP2-.ELTYPE)  THEN  COMP  :=  TRUE; 

5425  iS  ll\l  It  ENDr'''  '=  ^ASTTESTP 

ilp7  iS  mt  II  ^^    "^""^  COMP  THEN 

542I  iS  ll'l  II  BEGIN  NEW(LTESTPl); 

542^  iS  iti  II  "^^H  LTESTPl-  DO 

5430  iS  iV'l  ?1  ^"^"^  ^"-^^  •=  f^SPl-.ELTYPE; 

5431  iS  i^n  is  ^^^2  :=  FSP2-.ELTYPE; 

5432  iS  isis  8  ...h^'^^"^^  •=  e^OBTESTP 


END; 


?434  iS  is^B  II  SLOBTESTP  :=  LTESTPi; 

5435  iS  \l\l  28  £,0°""*  •=  "MPTYPES(FSP1-.ELTYPE,FSP2-.ELTYPE) 

5437  iS  isis  3?  EnS?"""""'"  '"^  '°'"  GLOBTESTP  :=  LTESTP2 

543I  iS  i5';:  Ti  )>lf^^T'   ^^^^^ypes  :=  true; 

5440  10  15:5  47  COMPTYPES  :=  COMRTYPES ( FSPl- .ELSET . FSP2-.ELSET ) ; 
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10 

ib:4 

59 
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10 

15:5 

b9 

54i+3 

10 

I5:s 

b9 

Sl'+'t 

10 

lb:6 

63 

St+f+S 

10 

15:6 

76 

5446 

10 

15:7 

H2 

5'+'+7 

10 

15:7 

87 

stf+a 

10 

15:7 

92 

s'+'+g 

10 

15:& 

U2 

5450 

10 

15:7 

12 

5151 

10 

15:6 

19 

5452 

10 

15:5 

22 

S^fSS 

10 

15:4 

24 

545*+ 

10 

15:5 

24 

S^+SS 

10 

15:6 

32 

5456 

10 

15:6 

35 

5457 

10 

15:7 

46 

5458 

10 

15:8 

56 

5459 

10 

15:7 

61 

5460 

10 

15:6 

66 

5461 

10 

15:6 

74 

5462 

10 

15:6 

79 

5463 

10 

15:5 

84 

5464 

10 

15:4 

89 

5465 

10 

15:5 

89 

5466 

10 

15:4 

93 

5467 

10 

15:3 

24 

5468 

10 

15:4 

26 

5469 

10 

15:5 

32 

5470 

10 

15:4 

35 

5471 

10 

15:5 

43 

5472 

10 

15:6 

49 

5473 

10 

15:5 

52 

5474 

10 

i5;o 

60 

5475 

10 

i5:o 

90 

5476 

10 

i5:o 

90 

5477 

10 

16:d 

1 

5473 

10 

i6:o 

0 

5479 

10 

i6:i 

0 

5480 

10 

i6:o 

5 

5481 

10 

i6:o 

22 

arrays: 

BEGIN 
COMP 


;=  comptypes(Fspi''.ae:ltypEiFSP2'^.aeltype) 


AMD 
IF  COMP  AND 

COMP  := 


(FS^l'^.AISPACKO  =  FSP2'^,AISPACKD) 
FSPl^.AISPACKD  THEN 
(FSOl'^.ELSPERWD  =  FSP2^.ELSPERWD ) 
AND  (FSPI'^.ELWIDTH  =  FSP2'^.ELWIDTH ) 
AND  (FSPI'^.AISSTRNG  =  FSP2''.AISSTRNG ) 
NOT  STRGTYPE(FSPl)  THEN 
FSP2'*,SIZE)  ; 


IF  COMP  AND 

COMP  :=  (FSPl'^.SIZE  = 

comptypes  :=  comp; 
end; 

RECORDS: 

BEGIN  NXTl  :=  FSPl'^.FSTFLD;  NXT2  :=  FSP2''.FSTFLD ; 
COMP  :=  TRUE? 

WHILE  (NXTl  <>  NIL)  AND  (NXT2  <>  NIL)  AND  COMP  DO 
BEGIN  C0MP:=C0MPTYPES(NXT1'^.IDTYPE,NXT2'*,IDTYPE); 


NXTl 

end; 
comptypes 


;=  nxti'^.next;  nxt2  :=  nxt2'*.next 


NIL)  AND 
=  NIL) 
=  NIL) 


:=  COMPTYPES  (FSP1'*.FILTYPE.FSP2^.FILTYPE) 


1=  COMP  AND  (NXTl  = 
AND  (FSPl'^.RECVAR 
AND  (FSP2^.RECVAR 

END? 

files: 
comptypes 

END  (♦CASE*) 
ELSE  (*FSP1'*.F0RM  <>  FSP2^.F0RM*) 
IF  FSPl'^.FORM  =  SUBRANGE  THEN 

COMPTYPES  :=  C0MPTYPES(FSP1'*,RANGETYPE.FSP2) 
ELSE 

IF  FSP2'^,F0RM  =  SUBRANGE  THEN 

COMPTYPES  :=  C0MPTYPES(FSP1,FSP2'*.RANGETYPE) 
ELSE  COMPTYPES  :=  FALSE 
END  (*C0MPTYPES*)  ; 


(NXT2  =  NIL) 


PROCEDURE  GENBYTE{*FBYTE:  INTEGER*) 
BEGIN 

CODEP'-CICD  :=  CHR(FBYTE); 
END  (♦GENBYTE*)  5 


IC  :=  IC+1 


sf+aa 

10 

17:d 

1 

5433 

10 

17:d 

2 

5484 

IG 

17: 0 

0 

5485 

10 

17:i 

0 

5486 

10 

i7:i 

3 

5487 

10 

i7:i 

16 

543S 

10 

17:2 

20 

5489 

10 

17:3 

20 

5490 

10 

17:3 

25 

5491 

10 

17:3 

35 

5492 

10 

17:2 

37 

5493 

IQ 

i7:i 

39 

5494 

10 

i7:o 

40 

5495 

10 

i7:o 

56 

5496 

10 

18:d 

1 

5497 

10 

i8:o 

0 

5498 

10 

18:i 

0 

5499 

10 

18: 1 

9 

5500 

10 

18:2 

15 

5501 

10 

18:3 

33 

5502 

10 

i8:i 

33 

5503 

10 

i8:o 

41 

5504 

10 

i8:o 

58 

5505 

10 

19:d 

1 

5506 

10 

19:d 

2 

5507 

10 

i9:o 

0 

5508 

10 

19:i 

6 

5509 

10 

19:2 

6 

5510 

10 

19:2 

15 

5511 

10 

19:2 

23 

5512 

10 

19:2 

34 

5513 

10 

19:2 

39 

5514 

10 

19:2 

47 

5515 

10 

19:3 

58 

5516 

10 

19:4 

58 

5517 

10 

19:5 

64 

5518 

10 

19:6 

34 

5519 

10 

19:4 

39 

5520 

10 

19:3 

97 

5521 

10 

19:2 

01 

5522 

10 

19:1 

02 

pkocedurh:  genwordc+fword:  integer*); 

VAR  Tri^P:  CHAR; 
BEGIN 

IF  ODD(IC)  THEN  K  :=  IC  +  1; 
!"I0VElEFT(FW0RD,C0DEP"CIC]»2)  ; 

IF  flipbytes  then 

BEGIN 

TEMP  :=  codep'^cicd; 

CODEP'^CIC]  :=  CODEP'^CIC  +  ID; 

CODEP'^CIC  +  1]  :=  TEMP 
END; 

IC  :=  IC  +  2 

END  (*GENWORD*)  ; 

PROCEDURE  WRITETEXT5 
BEGIN 

MOVELEFT(SYMBUFP'^CSYMCURSOR:»CODEP'*C0  3tl024)  ; 
IF  USERINFO.ERRNUM  =  0  THEN 

IF  BLOCKWRITE{USLRIl\|FO.WORKCODE'*tCODEP^[:03,2,CURBLK)  <>  2  THEN 
ERR0R(402) ; 

CURBLK  :=  CURBLK  +  2 

END  (♦^IRITETEXT*)  ; 

PROCEDURE  writecooe(*forcebuf:  boolean*); 

VAR  cooeinx*lic,i:  integer; 
begin  codeinx  :=  0;  lic  :=  ic; 

repeat 
I  :=  512-curbyte; 

if  I  >  LIC  THEN  I  :=  Lie; 

M0vELEFT(C0DEP-[:C0DElNXD,DISKBUFCCURBYTE3f  I)  ; 
CODEINX  :=  CODEINX+I; 

CUrbYTE  :=  CURBYTE+i; 

IF  (CURBYTE  =  512)  OR  F0RCE3UF  THEN 

BEGIN 

IF  USERINFO.ERRNUiW!  =  0  THEN 

IF  BLOCKWRITE(USERINFO.WORKCODE'',DISKBUF,1. CURBLK)  <>  1  THEN 
ERROR(402); 

CURBLK  :=  CURBLK+i;  CURBYTE  :=  Q 

END; 
Lie  :=  LIC-I 
UNTIL  LIC  =  0; 


-^n* 
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5523  10  19:o  11    END  ( *wR ITECODE* )  ; 

5524  IJ  19:o  i(i 

5525  10  26:d      1    PROCEDjrE  FINISHSEG? 

5526  IQ  26:0      1      VAR  I:  Ii^jTEGER! 

5527  10  2&:o      0    BEGIN  IC  :=  0; 

5528  10  26:i      3      FOR  I  :=  NEXTPROC-1  DOWWTO  1  DO 

5529  10  26:2  17        IF  pROCTABLEC n  =  0  THEN 

5530  10  26:3  23  GENWORD(O) 

5531  10  26:2  29        ELSE 

5532  10  26:3  33  3ENW0RD ( SEGINX+IC-PH0CTA3LECI D ) ; 

5533  10  26:i  54      GENByTE ( SEG ) ;  GENBYTE ( NEXTPROC-1 ) ; 

5534  10  26:i  63      SEGTA3LEC SEG J.CQDELENG  :=  SEGINX+IC; 

5535  10  26:i  74      WRITecODE ( TRUE ) ;  SEGINX  :=  0;  CODEINSEG  :=  FALSE 

5536  10  26:0  80    END  ( *FINISHSEG* )  ; 

5537  10  26:o  98 

5538  10  26:o  98 

5539  10  26:0  98  (*$I  #5 : PROCS.B.TEXT* ) 

5539  10  26:o  98  (*$I  «5 :3lOCK.TEXT* ) 

5540  10  26:o  98 

5541  10  20:D      1  PROCEDURE  BLOCK{*FSYs:  SETOFSYS*); 

5542  10  2o:D      5  LABEL  i; 

5543  10  20:d      5  VAR  BFSYFOUND:  BOOLEAN; 

5544  10  20:d      6 

5545  10  27:D      1    PROCEDURE  FINDFORIaI  ( FCP;  CTP); 

5546  10  27:0      0      BEGIN 

5547  10  27:i      0        IF  FCP  <>  NIL  THEN 

5548  10  27:2      5  WITH  FCP'^  DO 

5549  10  27:3      8  BEGIN 

5550  10  27:4      8  IF  KLASS  IN  CPR0C,FUNC3  THEN 

5551  10  27:5  16  IF  PFDECKIND  =  DECLARED  THEN 

5552  10  27:6  23  IF  PFKIND  =  ACTUAL  THEN 

5553  10  27:7  30  IF  FORWDECL  THEN 

5554  10  27:6  35  BEGIN 

5555  10  27:9  35  USERlNFO.ERRNUM  :=  1175  WRITELN (OUTPUT ) ; 

5556  10  27:9  46  WRITE ( OUTPUT tNAME. »  UNDEFINED') 

5557  10  27:8  75  END; 

5558  10  27:4  75  FINDFORy^l  ( RLINK )  ;  FINDFORW  (LLINK ) 

5559  10  27:3  81  END 

5560  10  27:0  83      END  (*FINDFORW*)  ; 

5561  10  27:o  96 

5562  10  20:0      0    BEGIN  (♦BLOCK*) 
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0 

7 

7 

la 

22 

22 

42 

42 

65 

74 

74 

77 

77 

82 

82 

94 

12 

16 

26 

31 

37 
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IF  (PJOSWAP)  AND  (STARTlNoUP)  THEN 
BlGIN 

SODYPARKFSYS'WIL)  ; 
EXIT(BLOCK)! 

ErJD! 
IF  (SY  IN  CUNITsYfSEPARATSY])  AND  (NOT  INMOqULE)  THEN 
BEGIN 

UNITPART(FSYS  +  CUNITSY , INTERSY , IMPLESY, ENDSYD) J 
IF  SY  =  PERIOD  THEN  EXIT(BLOCK) 

End; 
new3l0ck:=true; 

REPEAT 

IF  NOT  NEWBLOCK  THEN 
BEGIN 

OP  :=  false;  stmtlev  :=  0;  ic  :=  o?  lineinfo  :=  0; 

IF  (NOT  SYSCOMP)  OR  {LEVEL>1)  THEN  FINDF0RW(DISPLAYCT0P3.FNaME ) ; 
IF  INMODULE  THEN 

IF  TOS-.PREVLEXSTACKP'^.DFPROCP  =  OUTERBLOCK  THEN 
IF  (SY  =  ENDSY)  THEN 

BEGIN  FINISHSEG;  EXIT(BLOCK)  END 
ELSE  IF  (SY  =  BEGINSY)  THEN 

BEGIN  ERR0R(13);  FINISHSEG;  EXIT(BLOCK)  END; 
IF  SY  =  BEGINSY  THEN  INSYMBOL  ELSE  ERR0R(17); 
REPEAT 

BODYPART{FSYS  +  CCASESYD  -  CENDSY3»  TOS'^.DFPROCP)  ; 
BFSYFOUND  :=  (SY  =  TOS-^.BFSY)  OR  (INMODULE  AND  (SY  =  ENDSY)); 
IF  NOT  BFSYFOUND  THEN 
BEGIN 

IF  TOS'^.BFSY  =  SEMICOLON  THEN 

ERR0R(14)   (*SEMICOLON  EXPECTED*) 
ELSE   ERR0R(6);   (*  PERIOD  EXPECTED  *) 
SKIP(FSYS  +  CTOS'^.BFSY:); 
BFSYFOUND  :=  (SY  =  TOS-.BFSY)  OR  (INMODULE  AND  (SY  =  ENDSY)) 

UNTIL  (BFSYFOUND)  OR  (SY  IN  BLOCKBEGSYS) ; 
IF  NOT  BFSYFOUND  THEN 
BEGIN 

IF  TOS^.BFSY  =  SEMICOLON  THEN  ERR0R(14) 
ELSE  ERR0R(6);  (*PERIOD  EXPECTED*) 
DECLARATIONPART(FSYS) ; 
END 
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ELSE 
BEGIN 

IF  SY  =  SEMICOLO^J  THEN  INSYMBOL; 

IF  (NOTCSY  IN  CBEGINSY,PROCSY,FUNCSY.PROGSYD) )  AND 
(TOS".BFSY  =  SEMICOLON)  THEN 
IF  NOT  (INMODULE  AND  (SY  =  ENDSY))  THEN 
BEGIN 

EKR0R(6);  SKIP(FSYS); 
DECLARATIONPARTCFSYS) ! 
END 
ELSE  GOTO  1 
ELSE 
1:       BEGIN 

WITH  TOS-"  DO 
BEGIN 

if  dfprocp  0  nil  then 

dfprocp*,inscope:=false! 
if  issegment  then 

BEGIN 

IF  CODEINSEG  THEN  FINISHSEG; 
IF  DLINKERINFO  AND  (LEVEL  =  1)  THEN 
BEGIN  SEGTABLECSEGD.SEGKIND  1=  2? 

WRITELINKERINFO(TRUE) 
END 
ELSE 

IF  CLINKERINFO  THEN 

BEGIN  SEGTABLECSEG3.SEGKIND  :=  2; 

writelinkerinf0( false) 
end; 
nextproc:=soldproc; 
seg:=ooldseg; 
end; 
level:=doldlev; 
top:=dolotop; 
lc:=dllc; 

curproc:=poldproc; 
END; 
RELEASE(TOS'*.DMARKP)  ; 
T0S:=T0S'^.PREVLEXSTACKP; 

NEWBL0CK:=(SY  in  CPROCSYtFUNCSYtPROGSYD) ; 
END 
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END 


END 
EiviD 

Else 
begin  declarationpart(fsys) ; 
if  level  =  0  then 
if  sy  in  cunltsytseparatsyd  then 

BEGIN 

UNITPART(FSYS  +  CUNITSY , INTERSY , IMPLESY»ENDSY3) 5 
IF  SY  IN  CPR0CSY,FUNCSY,PR0GSY3  THEN  DECLARATIONPART (FSYS) 
END 
END; 
UNTIL  TOS  =  NIL; 
FINISHSEG; 

(♦Block*)  ; 


BEGIN  {*  PASCALCOMPluER  *) 

compinit; 

time(lgth»lowtime); 

bl0ck(3l0ckbegsys+statbegsys-ccasesy3); 
if  sy  0  period  then  err0r(21); 
if  list  then 
begin  screendots  :=  screendots+1 ! 

symbufp'^csymcursord  :=  chr(eol); 

symcursor  :=  symcursor+i; 

printline 

END! 
USERINFO.ERRBLK  :=  05 

TIME(LGTHiSTARTDOTS) ?  LOWTIME  :=  STARTDOTS-LOWTIME; 
UNITWRITE(3»IC,7); 

IF  dlinkerinfo  or  clinkerinfo  then 

BEGIN  SE6TABLECSEG3.SEGKIND  :=  1; 
WRITELINKERINFO(TRUE) 

end; 
cl0se(lp»l0ck); 

IF    noisy    then    WRITELN(OUTPUT) ! 
WRITE(OUTPUT»SCREENDOTS» •    LINES* ) ; 
IF    LOWTIME    >    0    THEN 

iA/RITE(OUTPUTi»t     ♦  .  (  LO!a/TIME  +  30  )    OIV    60t 
ROUND( (3600/LOWTIME)*SCREENDQTS) , • 
IF    NOISY    THEN 

BEGIN 


SECS,  », 
LINES/MIN') 


4G5 


IGn 


5686  10  1:3  96  WRIT£LN{0UTPUT) ; 

t>687  10  1:3  02  wr^ITE(OUTPJT, 'SMALLEST  AVAILABLE  SPACE  =  •  ,  SMALLESTSPACE 1  »  WORDS') 

5688  10  1:2  64  end; 

5689  10  1:1  64  IC  :=  o; 

5690  13  1:1  67  FOR  SEG  :=  0  TO  MAXSEG  DO 

5691  10  1:2  31  WITH  sEGTAQLECSEG 3  00 

5692  10  1:3  90  BEGIN  GENWORD ( DISKADDR ) ;  GENWORD ( CODELENG )  END; 

5693  10  1:1  09  FOR  SE3  :=  0  TO  MAXSE-G  DO 

5694  10  1:2  23  WITH  sEGTABLEC SEG 3  DO 

5695  10  1:3  32  FOR  LGTH  :=  1  TO  8  00 

5696  10  1:4  47  SENBYTE(ORD(sEeNAMECLGTHa)) ; 

5697  10  1:1  74  FOR  SEG  :=  0  TO  MAXSEG  DO  GENWORD ( SEGTABLECSEG3.SEGKIND ) ; 

5698  10  1:1  04  FOR  SEG  :=  0  TO  MAXSEG  DO  GENWORD( SEGTABLECSEG3.TEXTADDR) ; 

5699  10  1:1  34  FOR  LGTH  :=  1  TO  80  t)0 

5700  10  1:2  49  IF  COMMENT  <>  NIL  THEN  GENBYTE ( ORD (C0MMENT*CLGTHD) )  ELSE  GENBYTE(O); 

5701  10  1:1  77  FOR  LGTH  :=  1  TO  256  -  8*(MAXSEG  +  1)  •  40  DO  GENWORD{0); 

5702  10  111  13  CURBLK  :=  05  CURBYTE  :=  Oi  WRITECODE ( TRUE) 

5703  10  l;0  22  END  (*  PASCALCOMPILER  *)  5 

5704  10  1:0  78 

5705  0  1:0  0  BEGIN  (*  SYSTEM  *) 

5706  0  1:0  0  END. 


At  TtE  TIME  OF  THE  PRINTING  OF  THIS  BOOK 

the  basic  compiler  was  not  listed. 

The  basic  compiler  will  be  available  in 
A  supplimental  book  at  sor€  TIME  in  the 

FUTURE  at  additional  COST, 

Thank  you  for  your  patience  in  the  matter,  ed. 
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1  (*$L  PRINTER:*) 
1  C$1  LINKo  : 


1  (*  COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORWTa  !1 
1  *  PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFmRfoRDS^^^  ' 
1       *   TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENCE 


|.   OBTAINED  FRO»  THE  ^NSTIT^TE  ForiNFORWnoN  STsl^^S.'""'"''    " 


*) 
*) 

j^  - ■    ">«      ii'jr  u^riH  I  iUN     ayes  ICIvia,  ;^j 

1       ^***********************************************:,^*^^^^^ 

1  L$S+»U-tR+ 

1 
1 

1  IJCSD   PASCAL   SYSTEM 

1  PROGRAM   LINKER 

1  (VERSION  I.5F) 

1 

^  WRITTEN  SUMMER  '78  BY 

1  ROGER  T,  SUMNERt  IIS 

1  COPYRIGHT  (C)  1978»  REGENTS  OF 

1  THE  UNIVERSITY  OF  CALIFORNIA 

1      ALL  HOPE  ABANDON  YE  WHO  ENTER  HERE 
^  -DANTE 

1  2 
1 

1  PROGRAM  SYSTEMLEVEL; 

1 

1  CONST 

1      SYSPROG  =  «+; 
1 

1  VAR 

1  SYSCom:  '^INTEGER; 

2  GFILes:  ARRAY  CO..ba  OF  INTEGER; 

3  USERINFO:  RECORD 

8  filler:  ARRAY  C  0  . .  <+ ]  OF  INTEGER; 

«  slowterm,  stupid:  boolean; 
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4/0 


41  0  i:b  6  altmode::  char; 

H2.  0  i:;  '!  GOTSY^t  GJlCODt:  BOOLEAN; 

43  0  1-^  e  vJORKVlUt  SYMVID.  COOEVID:  STRINGC73; 

4^^  0  ijn  5  .-.ORKTIL),  SYMTID.  CODETID:  STRlNGClb] 

45  0  i;d  3  end; 

46  3  lie  dH  filler:  ARRAY  C0,.'+:  OF  INTEGER; 

H7  0  1:d  59  SYVIO,  DKVIO:  STRINGC73; 

46  0  i:'.j  67  JUNKl,  JJNK2:  iNTtGER; 

49  0  i:l)  &9  cmdstate:  integer; 

50  0  i:d  70 

51  0  i:u  70  c  ^^ 

52  0  1:D  70  *  THE  LINKER  IS  MADE  UP  OF  THREE  PHASES: 

53  0  1:D  70  *  PHASEl  WHICH  OPEN  ALL  INPUT  FILES,  READS  UP  SEG  TABLES 

54  0  i:d  70  *  FRO^  THEM  AND  DECIDES  WHICH  SEGMENTS  ARE  TO  BE 

55  0  1:D  70  *  LINKED  INTO  THE  FINAL  CODE  FILE, 

56  0  1:D  70  *  PHASE2  READS  THE  LINKER  INFO  FOR  EACH  SEGMENT  THAT  IS 

57  0  1:D  70  *  GOING  TO  BE  USED,  EITHER  TO  SELECT  SEP  PROCS  FROM 

53  Q  i:n  70  *             OR  COPY  WITH  MODIFICATIONS  INTO  OUTPUT  CODE. 

59  0  1:D  70  *  THE  MAIN  SYMBOL  TREES  ARE  BUILT  HERE,  ONE  FOR  EACH 

60  0  1:D  70  *  CODE  SEGMENT,                             ^   ^^ 

61  0  1:D  70  »  PHASES  DOES  THE  CRUNCHING  OF  CODE  SEGMENTS  INTO  THEIR 

62  0  1:d  70  *  FINAL  FOR"  BY  FIGURING  OUT  THE  PROCS  THAT  NEED  TO 
(,^  0  i:n  70  *             BE  LINKED  IN,  RESOLVES  ALL  REFERENCES  (PUBLREF, 

64  0  1-0  70  ♦  GL08REF,  ETC),  PATCHES  THE  CODE  POINTED  TO  BY  THEIR 

65  0  1:D  70  *  REFLISTS,  AND  WRITES  THE  FINAL  CODE  SEG(S), 

66  0  1:D  70  3 

67  0  i:d  70 

68  1  i:0      1  SEGMENT  PROCEDURE  LiNKERdll,  JJJ:  INTEGER); 

69  1  i:o    3 

70  1  1:D      3  CONST 

71  1  1:Q      3  HEADER  =  'LINKER  CI.5F3'; 

73  I  I'll              3  MAXSEG  =  15;  C  MAX  CODE  SEG  «  IN  CODE  FILES  2 

74  I  i:o      3  MAXSEGl  =  16;  C  MAXSEG+1,  USEFUL  FOR  LOOP  VARS  1 

75  1  i:n      3  MASTERSEG  =  i;  C  USERHOST  SEGMENT  NUMBER  «  1 

76  1  i:d      3  FIRSTSEG  =   7;  C  FIRST  LINKER  ASSIGNABLE  SEG  «  1 

77  1  l.n      3  MAXFILE  =7!  t  NUMBER  OF  LIB  FILES  WE  CAN  USE  1 

78  1  I'D      3  MAXLC  =  MAXINT;  C  MAX  COMPILER  ASSIGNED  ADDRESS  : 

7g  1  i-n      3  MAXIC  =  20000;  C  MAX  NUMBER  BYTES  OF  CODE  PER  PROC  3 

80  1  l!n      3  MAXPPOC  =  160 ;  C  MAX  LEGAL  PROCEDURE  NUMBER  2 

qI  I  1-3      3  MSDELTA  =  12;  C  MARK  STACK  SIZE  FOR  PU3/PRIV  FIXUP  2 
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TYPE. 


C  SUBRANGES  2 
c  -- J 

SEGRawGE  =  O..MAXSEG; 
SEGIr-JDEX  =  0..MAXSEG1; 
LCRA.MGE  =  L.MAXLC; 
ICRANGE  =  0..MAXIC; 
PROCRANGE  =  1..MAXPR0C5 

C  MISCELLANEOUS  3 


C  SEG  TABLE  SUBSCRIPT  TYPE  J 

L  WISH  WE  HAD  CONST  EXPRESSIONS!  3 

C  BASE  OFFSETS  A  LA  P-CODE  2 

Z  LEGAL  LENGTH  FOR  PROC/FUNC  CODE  3 

C  LEGIT  PROCEDURE  NUMBERS  1 


ALPHA  =  PACKED  ARRAY  CO, .73  OF  CHAR: 
DISKBLOCK  =  PACKED  ARRAY  CO. .5113  OF  0..255; 

filep^'^codefi^e;        '  '''''   ""'^^'^  '°  '^'   ^"^^  ' 

CODEP  =  -DISKBLOCK;  c  SPACE  MANAGEMENT... NON-PASCAL  KLUDGE  3 

C  -LINK  INFO  STRUCTURES  3 
C  - 3 


PLACeP  =  ^PLACEREC; 
PLACerEC  =  RECORD 

SRCBASE,  destbase: 

length:  ICRANGE 
END  C  PLACEREC  3  { 


C  POSITION  IN  SOURCE  SEG  3 


INTEGER; 


REFP  =  '"REFNODE; 
REFNODE  =  RECORD 

NEXT:  REFP; 

REFS;  ARRAY 
END  C  REFNODE 


C  IN-CORE  VERSION  OF  REF  LISTS  3 


CO. .73 
3  ; 


OF  INTEGER; 


LITYPES  r  (EOFMARK.  c  END-OF-LINK-INFO  MARKER  3 

C  EXT  REF  TYPES*  DESIGNATES       3 
C  FIELDS  TO  3E  UPDATED  BY  LINKER  3 

rrnlorr'  ^  ^^^^    ^°  INVISIBLY  USED  UNITS  (ARCHAIC?) 

GLOBREFt  c  REFS  TQ  EXTERNAL  GLOBAL  ADDRS  3 
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PUBLREF* 

privret. 

COiJSTREF, 

C  UtFINiNG  T 
L  LINKER  VAL 

GLOQDEFt 

PU3LDLF« 

CONSTDEIF, 

C  PROC/FUNC 
C  TO  PASCAL 
C  TO  PASCAL 

EXTPROC* 

EXTFJNC* 

SEPPROCt 

SEPFUNCi 

SEPPREF. 

SEPFREF) ; 


C  REFS  TO  BASE 
C  REFS  TO  BASE 
L  REFS  T3  HOST 

YPES,  GIVES 

UES  TO  FIX  REFS 
C  GLOBAL  AD3R 


LEV  VARS  IN  HOST  3 

VARS,  ALLOCATED  BY  LINKER 

BASE  LEV  CONSTANT  1 

3 

J 
LOCATION  1 


C  BASE 
L  BASE 


VAR  LOCATION  2 
CONST  DEFINITION 


INFOi  ASSEM 
AND  PASCAL 
INTERFACE 

C  EXTERNAL 

C 

C 

L 
C 

c 


3 
2 
2 

PROC 

"      FUNC 

SEPARATE  PROC 

"       FUNC 

REF  TO 

REF  TO 


TO 


LINKED 


BE 
II   II 

DEFINITION 
II 


PASCAL 
II 


SEP 
SEP 


PROC 
FUNC 


INTO  PASCAL 
II       II 

RECORD  2 
•'     2 
2 

2 


USET  =  SET  OF  LiTYPES; 
OPFORMAT  =  (WORD,  BYTE*  BIG); 


I    INSTRUCTION  OPERAND  FIELD  FORMATS  2 


C  FORMAT  OF  LINK  INFO  RECORDS 
ALPHA; 

LITYPES  OF 


LIENtrY  =  RECORD 
NAME: 

CASE  litype: 

SEpPREFf 
SEPFREF, 
UNlTREFi 
GLOBREF, 
PUBLREFf 
PRIVREF, 

constref: 

(format:   opformat; 
nrefs;   integer; 
imwords:  lcrange; 
reflist:   refp); 

EXTPROC. 

EXTFUNCt 
SEPPROC, 
SEPFUNC: 

(SRCPROC: 
l\|PARAMS: 


procrange; 
integer; 


HOW  TO  DEAL  WITH  THE  REFS  2 
WORDS  FOLLOWING  WITH  REFS  2 
SIZE  OF  PRIVATE  OR  NPARAMS  2 
LIST  OF  REFS  AFTER  READ  IN  3 


THE  PROCNUM  IN  SOURCE  SEG 
WORDS  PASSED/EXPECTED  3 
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191 

192 

193 

194 
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f^lace:  placep); 

5L0BDEF: 

(iiomeproc:   procraimge; 
icoffset:   icrange); 

PUBLDEF: 

(8ASE0FFSET:  LCRaNGE); 

constdef: 

(CONSTVAL:  INTEGER); 
EOFMARK: 

(NEXTLC:  LCRANGE) 
END  C  LIENTRY  1    ; 


L  POSITION  IN  SOURCE/OEST  SEG  2 

L  WHICH  PROC  IT  OCCURS  IN  2 

C  ITS  BYTE  OFFSET  IN  PCODE  3 

C  COMPILER  ASSIGN  WORD  OFFSET  D 

C  USERS  DEFINED  VALUE  1 

C  PRIVATE  VAR  ALLOC  INFO  1 


C  SYMBOL  TABLE  ITEMS  3 
C 1 

SYMP  =  ''SYMBOL; 

SYMBOL  =  RECORD 

LLINK,  RLINK, 
SLINK:  SYMP; 
entry;  LIENTRY 
END  C  SYMBOL  1    ; 

C  SEGMENT  INFORMATION  3 
C  — 1 

SEGKINDS  =(LINKEDi 
HOSTSEG» 
SEGPROCi 
UNITSEGt 
SEPRTSEG); 

FINFOP  =  '^FILEINFOREC; 


C  BINARY  SUBTREES  FOR  DIFF  NAMES  1 
I    SAME  NAME*  DIFF  LITYPES  1 
L    ACTUAL  ID  INFORMATION  3 


C  NO  WORK  NEEDED,  EXECUTABLE  AS  IS  3 

C  PASCAL  HOST  PROGRAM  OUTER  BLOCK   3 

C  PASCAL  SEGMENT  PROCEDURE*  NOT  HOST  3 

C  LIBRARY  UNIT  OCCURANCE/REFERENCE  3 

C  LIBRARY  SEPARATE  PRQC/FUNC  TLA  SEGMENT  3 

C  FORWARD  TYPE  DEC  3 


segp  =  '^segrec; 
segrec  =  record 

srcfile:  finfop; 

srcseg:  segrange 

symtab:  SYMP; 

case  segkind:  segkinds  of 

SEPRTSEG: 

(NEXT:  SEGP)     C  used  FOR  LIBRARY  SEP  SEG  LIST  3 


C  THIS  STRUCTURE  PROVIDES  ACCESS  TO  ALL  3 
C  INFO  FOR  SEGS  TO  BE  LINKED  TO/FROM     3 

Z    SOURCE  FILE  OF  SEGMENT  3 

C  SOURCE  FILE  SEG  U    3 

C  SYMBOL  TABLE  TREE  3 
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END  C  SEGKEC  3  5 


VAR 


HOST/LIB  FILE  ACCESS 


INFO  3 
2 


I5SEGTBL  =  RECORD    C  FIRST  FULL  BLOCK  OF  ALL  CODE  FILES  1 
DISKINFO:  ARRAY  CSEGRAfNlGE3  OF 
RECORD 

COOELENG,  CODEADDr:  INTEGER 
ENO  C  OISKIMFO  2    5 
SEGNAME:  ARRAY  CSEGRANGED  OF  ALPHA} 
SEGKIND:  array  CSEGRANGE3  OF  SEGKINDS5 

filler:  array  no. ,1433  of  integer 

END  C  I5SEGTBL  1    ; 
FILEKIND  =  (USERHOST.  USERLIBt  SYSTEMLIB); 


fileinforec 


=  RECORD 

next:  finfop;  c 

code:  filepj  c 

fkind:  filekindj  c 

SEGTBL:  I5SEGTBL  I 
END  C  FILEINFOREC  1    \ 


LINK  TO  NEXT  FILE  THATS  OPEN  3 
POINTER  TO  PASCAL  FILE. , .SNEAKY  I 
USED  TO  VALIDATE  THE  SEGKINDS  3 
DISK  SEG  TABLE  W/  SOURCE  INFO  3 


HOSTFILE, 
LIBFILES:  FINFOP; 

seplist:  segp; 
reflitypes:  liset; 


C  host  file  info  PTR,  its  next  =  LIBFILES  3 

C  list  of  LIB  FILES,  USER  AND  SYSTEM  3 

C  LIST  OF  SEP  SEGS  TO  SEARCH  THROUGH  3 

C  THOSE  LITYPES  WITH  REF  LISTS  3 


TALKATIVE. 

useworkfile:  boolean; 

errcount:  integer; 
heapbase:  '^integer? 

HosTsp:  segp; 

nextbaselc:  lcrange; 

seginfo:  array  csegrange3  of  segp; 


C  PTR  TO  HOST  PROG  OUTER  BLOCK  3 

C  NEXT  BASE  OFFSET  FOR  PRIVATE  ALLOC  3 

C  SEG  IS  AVAILABLE  IF  NIL  3 
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29 
30 
30 
51 
51 
51 
bl 
11 
11 
12 
12 
12 
12 
12 

1 
43 

0 

0 
20 
20 
73 
81 
89 
93 
99 
00 
18 

1 

2 

2 

2 

2 

2 

2 

0 

0 

4 
19 
34 
37 
50 


f^lEXTSEG:     SEGINDEX; 

^APNamE:     STRIf\IGC403; 

F0»     n.    F2t    F3i 
F4  »     F5  «     F6  t     F7  t 

CODE:  cooefile; 

Flipped:  boolean; 

print  an  error  message  and  bu:-^1p 
the  error  counter. 


C  NEXT  SLOT  IN  SEGINFO  AVAILABLE  D 


L    INPUT  FILES  WITH  LURKING  PNTRS  1 

C  OUTPUT  CODE  FILE.  *SYSTEM, WRK.CODE  1 

Z    ARE  FILES  BYTE-FLIPPED?  2 


PROCEDURE  ERROR(NlSG:  STRING); 

VAR  CH:  CHAR; 
BEGIN 

WRITELN{MSG) ; 

REPEAT 

WRITeLN(«TYPE  <SP>(C0NTINUE),  <esc>(terminate)»); 
READ(KEYBOARO.  CH)? 
IF  CH  =  USERINFO.ALTMODE  THEN 
EXlT(LINKER) 
UNTIL  CH  =  •  •  ; 

errcount  :=  errcount+1 
END  c  error  3  ; 

procedure  BYTESWAP(\/aR  WORD:  INTEGER); 
VAR  TEiw!Pl,TEMP2:  PACKED  RECORD 
CASE  BOOLEAN  OF 

TRUE:  (val:  integer); 
false:  (Lowbyte:  0..255; 

HIGHBYTE:  0..255) 

end; 

1.\/AL  :=  WORD; 

2. LOWBYTE  :=  TEWPl.HlGHBYTE ; 
2. HIGHBYTE  :=  TEMPI .LOWBYTE ; 
:=  TEMP2.VAL; 


£GIN 
TEMP 

TEMP 

TEMP 
WORD 

nd; 
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287    1 

3:o 

50 

288    1 

3:o 

bO 

289    1 

3:o 

5  0 

290    1 

3:g 

50 

291    1 

3:o 

bO 

292    1 

3:o 

50 

293    1 

3:o 

50 

294    1 

f  :d 

3 

295    1 

'+:o 

0 

296    1 

^•.1 

0 

297    1 

4:0 

2 

293    1 

'+:o 

18 

299    1 

5:d 

3 

300    1 

5:d 

5 

301    1 

5:0 

0 

302    1 

5:1 

0 

303    1 

5:1 

8 

30*+    1 

5:1 

8 

305    1 

5:1 

17 

306    1 

5:0 

17 

307    1 

5:0 

32 

308    1 

6:d 

1 

309    1 

6:0 

0 

310    1 

6:1 

0 

311    1 

6:0 

2 

312    1 

6:0 

16 

313    1 

7:d 

1 

31*+    1 

7:0 

0 

315    1 

7;o 

0 

316    1 

7:1 

0 

317    1 

7:1 

9 

318    1 

7:u 

17 

319    1 

7:0 

30 

320    1 

8:d 

1 

321    1 

aiD 

4 

322    1 

8:d 

4 

323    1 

8:d 

1 

32f    1 

8:0 

4 

325    1 

8:d 

4 

326    1 

8:d 

4 

327    1 

8:0 

0 

*  ROUTINES  TO  ACCESS  U3JECT  CODE  SEGMENTS.   THERE 

*  IS  SU3TLE  3USI^JESS  INVOLVING  -BYTE  FLIPPING  WITH 

*  THE  16-3IT  OPERATIONS. 
3 

c$R-: 

FUNCTION  fetchbyteccp:  codep;  offset:  integer):  integer; 

BEGIN 

FETCHBYTE  :=  CP'^C  OFFSET  3 
END  C  FETCHBYTE  1    ? 

FUNCTION  fetchword(cp:  codep;  offset:  integer):  integer; 
VAR  i:  integer; 

BEGIN 

M0VELEFT(CP''C0FFSET3«  It  2); 

C  BYTE  SWAP  I  ] 

IF  FLIPPED  THEN  BYTESWAP(I); 

fetchworo  :=  i 
END  c  fetchword  3  ; 

PROCEDURE  ST0REBYTE(VAL:  INTEGER;  CP:  CODEP;  OFFSET:  INTEGER); 
BEGIN 

cp'^coffseT3  :=  val 

END  C  STGrEBYTE  3  ; 

PROCEDURE  ST0REW0RD(VAL:  INTEGER;  CP:  CODEP;  OFFSET:  INTEGER); 
BEGIN 

C  BYTE  SWAP  VAL  3 

IF  FLIPPED  THEN  BYTESWAP ( VAL ) ; 

MOVELEFT(VAL»  CP'^C0FFSET3 ,  2) 
END  C  SToREWORD  3  ; 

PROCEDURE  STORESIG(VaL:  INTEGER;  CP:  CODEP;  offset:  INTEGER); 
VAR   BIGWORD:  PACKED  RECORD 

case  boolean  of 
true:  (Integ:  integer); 
false:  (lowbyte:  0..255; 

HIGHBYTE:  0.,255) 
END; 

begin 
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X 
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1 
1 
1 
1 
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:i 
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15 
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38 

38 

38 

38 

38 
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3 

3 

3 

3 
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29 
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86 

86 

86 

86 

86 
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3IGW0«D.INTEG  :=  VAL; 

cp^coffsetd  :=  bigword.highbyte  +  128; 

CP'^COPFStT  +  i;]  :=  3i&W0RD.L0W3YTE: 

lNd; 


BYTE-FLIP  WORD  QUANTITIES  IN  SEGMENT  DICTIONARY 
FOR  ByTEI-FLIPPED  FILE  CASE  ON  READING  AND  WRITING 
SEGTA3LE:S.   called  by  PHASEl  AND  PHASE3. 


PROCEDURE 
VAR 


TABLE:  I5SEGTBL) 


FLIPTA3LE{VAR 

s:  segrange; 
word:  record 

case  boolean  of 

true:  (INt:  integer); 

false:  (KIND:  segkinds) 

END; 


BEGIN 
FOR 


MAXSEG  do 
DISKINF0CS3 


END: 

C 
* 

* 

♦ 
♦ 
3 


:=  0  to 

with  table,  diskinf0cs3  do 

BEGIN 

byteswap(codeaddr) ; 
byteswap(codeleng) ; 

word. KIND  :=  SEGKINDCS]; 
BYTESWAP(WORD,lNT) ; 

segkindcsd  :=  word. kind; 

end; 


enter  mEWSYM  in  SYMTAB  tree.   the  TREE  IS  BINARY  FOR 
DIFFERENT  NAMES  AND  ENTRIES  WITH  THE  SAME  NAME  ARE  ENTERED 
ONTO  SIDEWAYS  LINKS  (SLINK),   NO  CHECK  IS  MADE  FOR  DUP 
ENTRY  TYPES,  CALLER  MUST  DO  THAT.   NODES  ON  SLINK  WILL 
ALWAYS  HAVE  NIL  RLINK  AND  LLINK. 


PROCEDURE  ENTERSYM(NEWSYM:  SYMP;  VAR  SYMTAB:  SYMP); 
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3&9  1  10:D  3  VAR  SYP,  LASTSYP:  SYMP; 

370  1  10:0  5  use;left:  boolean*' 

371  1  iO:0  0  BEGIN 

372  1  10:1  0  NEWSYM'^.LLINK  :=  iMIL; 

373  1  10:1  5  NEXSYM'-.RLINK  :=  NIL? 
37f  1  10:1  10  NEinlSYM-, SLINK  :=  NIL! 

375  1  10:1  13  IF  SYI^TAB  =  NIL  THEN 

376  1  10:2  19  SYMTaB  :=  NEWSYM 

377  1  10:1  20  ELSE 

378  1  10:2  21  BEGIN  C  SEARCH  SYMTAB  AND  ADD  NEWSYM  2 

379  1  10:3  24  SYP  :=  SYI^ITAB; 

380  1  10:3  28  REPEAT 

381  1  lOU  28  LASTSYP  :=  SYPJ 

382  1  lO:^  31  IF  SYP'^. ENTRY. NAME  >  NEWSYM*^. ENTRY. NAME  THEN 

383  1  10:5  '+2  BEGIN  SYP  :=  SYP'^.LLINK;  USELEFT  :=  TRUE  END 

384  1  10:4  49  ELSE 

385  1  10:5  51  IF  SYP*". ENTRY, NAME  <  NEWSYM'^. ENTRY. NAME  THEN 

386  1  10:6  62  BEGIN  SYP  :=  SYP'^.RLINK;  USELEFT  :=  FALSE  END 

387  1  10:5  69  ELSE  L    EQUAL  2 

388  1  10:6  71  BEGIN  C  ADO  INTO  SIDEWAYS  LIST  1 

389  1  10:7  71  NEWSYM'*. SLINK  :=  SYP'*. SLINK; 

390  1  10:7  75  SYP'*. SLINK  :=  NEWSYM; 

391  1  10:7  78  LASTSYP  :=  NIL;  C  ALREADY  ADDED  FLAG  1 

392  1  10:7  81  SYP  :=  NIL  C  STOP  REPEAT  LOOP  1 

393  1  1Q:6  81  END 

394  1  10:3  34  UNTIL  SYP  =  NIL! 

395  1  10:3  39  IF  LASTSYP  <>  NIL  THEN 

396  1  10:4  94  3ESIN  C  ADD  TO  BOTTOM  OF  TREE  2 

397  1  10:5  94  IF  USELEFT  THEN 

398  1  10:6  97  LASTSYP^, LLINK  :=  NEWSYM 

399  i  10:5  00  ELSE 

400  1  10:6  04  LASTSYP-*. RLINK  :=  NEWSYM 

401  1  10:4  07  END 

402  1  10:2  09  END  C  SYMTAB  <>  nH-  2 

403  1  10:0  09  END  C  ENteRSYM  2    i 

404  1  10:0  24 

405  1  10:0  24  C 

406  1  10:0  24  *   LOOK  UP  NAME  IN  SYMTAB  TREE  AND  RETURN  POINTER 
4C7  1  10:0  24  *   TO  IT,   OKTYPE  RESTRICTS  WHAT  LITYPE  IS 

408  1  10:0  24  *   ACCEPTABLE.   NIL  IS  RETURNED  IF  NAME  NOT  FOUND. 

409  1  10:0  24  ] 
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FUNCTION  3YMSRCH(\/Ak  NAME:  ALPHA; 

VAR  SYp:  SYMp; 
BEGIN 

SYMSRCH  :=  nil; 
SYP  :=  symtab; 

WHILE  SYP  <>  NIL  DO 

IF  SYP*^. ENTRY. NAME  >  NAME  THEN 

SYP  :=  SYP'^.LLINK 
ELSE 

IF  SYP'^.ENTRY.NAME  <  NAME  THEN 

SYP  :=  SYP'^.RLINK 
ELSE  C  EQUAL  NAME  1 

IF  SYP'^. ENTRY. LITYPE  <>  OKTYPE  THEN 

SYP  :=  SYP'*. SLINK 
ELSE  C  FOUND!  J 

BEGIN  SYMSRCH  :=  SYP;  SYP  :=  NIL  END 
END  C  SYMSRCH  1    \ 


OKTYPE:  LITYPES;  SYMTAB:  SYMP):  SYMP; 


SEARCH  FOR  THE  OCCURANCE  OF  THE  UNIT  SEGMENT 
GIVEN  BY  NAME  IN  THE  LIST  OF  FILES  IN  FP. 
RETURN  THE  FILE  AND  SEGMENT  NUMBER  IN  SEG. 
NIL  IS  RETURNED  FOR  NON-EXISTANT  UNITS  AND 
AN  ERROR  IS  GIVEN. 


FUNCTION  UNITSRCHCFP: 
LABEL  1; 

VAR  S:  SEGINDEX; 
BEGIN  SEs  :=  0; 

WHILE  FP  <>  NIL  DO 
BEGIN 

WITH  FP^.SEGTBL 
FOR  S  :=  0  TO 


FINFOP;  VAR  name:  ALPHA;  VAR  SEGI  SEGRANGE):  FINFOP; 


FP 

end; 
write( 'unit 


DO 

MAXSEG  DO 
IF  SEGNAMECSJ  =  NAME  THEN 

IF  SEGKINDCS3  =  UNITSEG  THEN 
GOTO  1; 
=  FP'^.NEXT 


NAME) 
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t^si   ; 

L    12:1 

01 

452    : 

L    12:1 

Ifa 

453 

L    12:1 

22 

454    : 

L    12:1 

22 
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28 

456    J 

L    12:0 

28 

457    : 

L   12  ;o 

48 

458 

L    12:0 

48 

459    ] 

L    12:0 

48 

460    ] 

L    12:0 

48 

461    ] 

L    12:0 

48 

462    ] 

L    12:0 

48 

463   : 

L   i2:n 

48 

464    ] 

L   13:d 

3 

465    ] 

L   13:d 

4 

466    ] 

L   13:d 

4 

467    ] 

L   13:o 

0 

468    ] 

L   I3:i 

0 

469    ] 

L    13:1 

3 

470    ] 

L    13:2 

14 

471    1 

L    13:3 

39 

472    3 

L   I3:i 

48 

473    ] 

L   i3;i 

51 

474    ] 

L   i3:o 

51 

475    ] 

L    13:0 

66 

476    1 

L    13:0 

66 

477    ] 

L    13:0 

66 

478    ] 

L    13:0 

00 

479    3 

L    13:0 

36 

480    ] 

L    13:0 

66 

481    ] 

L    13:0 

66 

482    ] 

L   14:d 

3 

483    a 

L   14:d 

4 

484    ] 

L    14:0 

4 

485    ] 

L   14;d 

4 

486    ] 

L   14;d 

4 

487    ] 

L   14:d 

4 

488    ] 

14:0 

0 

489   a 

14:1 

0 

490    1 

I4:i 

3 

491    1 

i4:o 

3 

ERROR ( •  HOT    FOUND* ) ; 

s  :=  0; 

1: 

SEG  :=  s? 
UNITSRCH  :=  FP 
END  C  UNITSRCH  ]  ; 


*  ALPHABETIC  RETURNS  TRUE  IF  NAME  CONTAINS  ALL  LEGAL 

*  CHARACTERS  FOR  PASCAL  IDENTIFIERS.   USED  TO  VALIDATE 

*  SEGNAMES  AND  LINK  INFO  ENTRIES, 
] 

FUNCTION  ALPHABETIC(vAR  NAME:  ALPHA):  BOOLEAN; 

LABEL  1; 

VAR  i:  INTEGER; 
BEGIN 

ALPHABETIC  :=  FALSE? 

FOR  I  :=  0  TO  7  DO 

IF  NOT  (NAMECi:  IN  C'A'..»Z»f  •0»..»9'«  •  '«  * ~* 1)    THEN 

GOTO  1; 
ALPHABETIC  :=  TRUE; 
1: 

END  C  ALPHABETIC  1    ; 


♦  GETCODEP  IS  A  SNEAKY  ROUTINE  TO  POINT  CODEP'S  ANYWHERE 

♦  IN  MEviORY,   IT  VIOLATES  ROBOT'S  RULES  OF  ORDERf  BUT  IS 

♦  VERY  USEFUL  FOR  DEALING  WITH  THE  VARIABLE  SIZE  SEGMENTS 
D 

FUNCTION  GETCODEP(MEMADDR:  INTEGER):  CODEP; 
VAR  r:  RECORD 

CASE  BOOLEAN  OF 

true:  (i:  integer); 
false:  (p:  codep) 

END; 
BEGIN 

r.i  :=  memaddr; 
getcodep  :=  r.p 

end  I:  GETCODEP  2    \ 


^+'^2  1  14:o  18 

'+'^i  1  i^:g  la  c$i  linko  3 

^+93  1  m:c  IS  c£i  LINK!  : 

'+9'f  1  14:  Q  18 

'^'^5  1  i'+:u  18     (***  +  *♦*****♦**♦******************♦*♦***♦♦♦****♦***♦*♦♦♦***♦***♦*♦♦) 

'+96  1  14:0  18      (*  #, 

^+^7  1  1^:0  18      (*   COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.    *) 

'^^Q  1  1*^:0  19      (*   PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-     ♦) 

^+99  1  li+:o  18      {♦   TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE    *) 

500  1  I'+IO  18      (*   OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS,  *) 

501  1  ltf:o  18      (*  *, 

502  1  14:0  18      (****************♦****♦*************♦*****♦**********♦**♦******♦**♦) 

505  1  m:c  18 

SO"*  1  14:0  18  c 

505  1  14:o  18  *      PHASE  1  OPENS  HOST  AND  LIBRARY  FILES  AND 

506  1  14:o  18  *   READS  IN  SEG  TABLES.   ALL  FIELDS  ARE  VERIFIED 

507  1  14:o  18  *   AND  THE  HOSTFILE/LlBFILES  FILE  LIST  IS  BUILT. 

508  1  I'+tO  18  *   THE  PROTOTYPE  FINAL  SEG  TABLE  IS  SET  UP  IN 

509  1  m:o  18  *      SEGINFOC*:  FROM  THE  HOST  FILE  AND  THE  SEP  SEG 

510  1  14:o  18  *   LIST  IS  SET  UP  FOR  SEARCHING  IN  LATER  PHASES, 

511  1  14:o  18  3 

512  1  14:o  18 

513  1  15:d      1  PROCEDURE  PHASEl; 

514  1  15:d      1 

515  1  15:D      1    VAR   C  FOR  USE  WITH  BYTE  FLIPPING  2 

516  1  i5:d    1        highbyte:  o..x; 

517  1  15:d      2  INT:  RECORD 

518  1  15:d      2  CASE  BOOLEAN  OF 

519  1  i5:d    2  true:  (val:  integer); 

520  1  15:d      2  false:  (BYTE:  PACKED  ARRAY  CO. ,13  OF  0..255) 

521  1  15:D      2  END; 

522  1  15:o      3      C 

523  1  15:D  3      *   BUILD  FILE  LIST  OPENS  INPUT  CODE  FILES  AND  READS  SEGTBLS. 

524  1  15:d      3      *   The  VAR  HOSTFILE  is  set  UP  AS  HEAD  OF  LINKED  LIST  OF  FILE 

525  1  15:d      3      ♦   Info  RECS.   the  order  of  these  files  determines  HOW  ID'S 

526  1  15:d  3      *   WILL  3E  SEARCHED  FOR.   NOTE  THAT  LIBFILES  POINTS  AT  THE 

527  1  15:D  3      *   LIST  JUST  PAST  THE  HOST  FILE  FRONT  ENTRY. 

528  1  15:d  3      2 

529  1  15:d  3 

530  1  16:3  1      PROCEDURE  BUILDFILELIST ; 

531  1  16:d  1        LABEL  i; 
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:> 


532 

16:d 

1 

533 

16:d 

2 

53^+ 

16:,D 

3 

535 

16:0 

5 

536 

16:d 

25 

537 

i6:o 

25 

538 
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25 
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25 

540 
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25 
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i&:d 

25 
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17:d 

1 
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45 
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i7:d 

45 
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i7:c 

46 
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47 

547 

17:d 

48 
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17:d 

49 

549 

17:d 

50 

550 

17:d 

51 

551 

17:d 

51 

552 

17:d 

51 

553 

17:d 

51 

554 

17. 'D 

51 

555 

17:d 

51 

556 
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3 

557 

18:d 

4 

558 

i8:o 

0 

559 

i8:o 

0 
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i8:i 

0 
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i8:i 

9 
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i8:o 

9 

563 

i8:o 

22 

564 

i7:o 

0 

565 

i7:i 

0 

566 

i7:i 

8 

567 

i7:i 

19 

566 

i7:i 

30 

569 

i7:i 

41 

570 

i7:i 

52 

571 

i7:i 

63 

572 

i7:i 

74 

VAK  F:  O..MAXFILE: 
i:  INTEGER; 
Pf  a:    FINFCP5 
FNAME:  STRINGC39D; 


*  SETUPFILE  OPENS  FILE  AND  ENTERS  NEW  FINFO  REC  IN 

*  HOSTFILE  LIST.   SEGTBL  IS  READ  IN  AND  VALIDATED. 

2 

PROCEDURE  SETUPFILE{NUM:  INTEGER;  KIND:  FILEKIND;  TITLE:  STRING); 
LABEL  l; 
VAR  errs:  INTEGER; 

s:  segindex; 
cp:  filep! 
fp:  finfop; 
alllinked:  boolean; 
goodkinds:  set  of  segkinds; 

*  GETFILEP  RETURNS  A  POINTER  TO  A  FILE  USING  UNSPEAKABLE 

*  METHODS*  BUT  THE  ENDS  JUSTIFY  THE  MEANS. 
1 


FUNCTION 

VAR  a: 

BEGIN 

c$R-:] 

GETFILEP 
C$R+3 
END  C  GETFILEP 


GETFILEP(VAR  F: 
ARRAY  CO., 0  3  OF 


CODEFILE) 
FILEP; 


FILEP; 


:=  AC-13; 


3EGIN  C  SETUPFILE  3 
CASE  NUM  OF 

O:  CP  :=  GETFILEPCFO) 

i:  CP  :=  GETFILEP(FI) 

Z:  CP  :=  GETFILEP(F2) 

3:  CP  :=  GETFILEP{F3) 

(+:  CP  :=  GETFILEP(F4) 

5:  CP  :=  GETFILEP(F5) 

6:  CP  :=  GETFILEP(F6) 


573 

i7:i 

35 

57*+ 

i7:i 

67 

bTb 

I7:i 

la 

575 

17:1 

27 

577 

17:2 

33 

57b 

17:3 

b^ 

579 

17:4 

5*+ 

580 

17:4 

74 

581 

17:3 

83 

582 

I7:i 

83 

583 

17:2 

89 

58*+ 

17:3 

89 

585 

17:3 

07 

586 

17:3 

11 

587 

17:^ 

16 

588 

17:2 

17 

589 

17:1 

21 

590 

17:2 

23 

591 

17:3 

23 

592 

17:1 

26 

593 

17:3 

59 

59tf 

17:3 

66 

595 

17:3 

70 

596 

17:3 

77 

597 

17:3 

83 

598 

17:^ 

02 

599 

17:3 

20 

600 

17:1+ 

2*+ 

601 

17:5 

24 

602 

17:6 

29 

603 

17:7 

48 

604 

17:8 

48 

605 

17:8 

63 

606 

i7:a 

78 

607 

17:9 

83 

608 

17:7 

85 

609 

17:5 

93 

610 

17:6 

98 

611 

17:6 

04 

612 

17:5 

04 

613 

17:5 

13 

7:   CP  :=  GETFILEP(F7) 
ENLJ  I     CASES  J  ; 
RESEKCP'*,  TITLE); 
IF  lORESULT  <>  0  THEN 

IF  TITLE  <>  'IN  IfllORKSPACE*  THEN 
BEGIN 

INSERT( '.CODE',  TITLE,  LENGTH ( TITLE ) +1 ) ; 
RESET(CP'^,  TITLE) 
END; 
IF  IORESUlT  0  0  THEN 
BEGIN 

INSERTCNO  FILE  •,  TITLE*  1); 
ERROR(TITLE) ; 
IF  KIND  <>  USERHOST  THEN 
ERRCOUNT  :=  ERRCOUNT-1 
END 
ELSE 

BEGIN  C  FILE  OPEN  OK  1 
IF  TALKATIVE  THEN 

WRITELN( 'OPENING  »i  TITLE)? 
NEW{FP); 

FP^.NEXT  :=  hostfile; 
FP^.CODE  :=  cp; 

FP'^.FKIND  :=  KIND; 

IF  BLOCKREAD(CP'*t  FP'*,SEGTBL»  If  0)  <>  1  THEN 

errorCsegtbl  read  ERRM 

ELSE 

BEGIN  C  NOW  CHECK  SE6TBL  VALUES  ] 

IF  NUM  =  0  THEN  C  DETERMINE  IF  FILE  IS  BYTE-FLIPPED  D 
FOR  S  :=  0  TO  MAXSEG  DO 
BEGIN 

INT.VAL  :=  ORD(FP'^.SEGTBL.SEGKINDCSD); 
FLIPPED  :=  (INT.BYTECHIGHBYTE3  <>  0); 
IF  FLIPPED  THEN 
GOTO  1; 
end; 

1:   IF  FLIPPED  THEN 

FLIPTABLE(FP'*,SEGTBL)  ; 

S  :=  0;  ALLLINKED  \-    TRUE; 
ERRS  :=  ERRCOUNT; 
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dbc34 


611  : 

L    17:5 

16 

615   : 

L    17:6 

21 

616    ] 

L    17:5 

21 

617    ] 

L    17:6 

29 

618    ] 

L   i7:& 

35 

619    J 

L    17:5 

35 

620    ] 

L    17:6 

11 

621    ] 

L    17:7 

11 

622    ] 

L    17:7 

56 

623    ] 

L    17:8 

70 

624    ] 

L    17:9 

70 

625    ] 

L    17:8 

91 

626    1 

L    17:7 

91 

627    ] 

L    17:7 

10 

626    3 

L    17:7 

22 

629    ] 

L   17:8 

39 

630    ] 

L    17:8 

12 

631    ] 

L    17:9 

59 

632   : 

L    17:7 

78 

633   : 

L    17:7 

90 

63tf    ] 

L    17:7 

02 

635   : 

L    17:8 

20 

636    ] 

L    17:7 

37 

637    ] 

L    17:8 

56 

638   : 

L    17:7 

73 

639   : 

L    17:8 

91 

610   : 

L    17:7 

08 

611    1 

L    17:8 

11 

612    1 

L    17:7 

20 

613    ] 

L    17:6 

22 

611   : 

L    17:5 

35 

615   : 

L    17:6 

13 

616    ] 

L    17:7 

13 

617    ] 

L    17:7 

68 

618   : 

L    17:6 

72 

619    ] 

L    17:5 

72 

650    ] 

L    17:6 

78 

651    ] 

L   i7:i 

78 

652   : 

L    17:2 

82 

653    ] 

L   i7:o 

82 

651    ] 

L   i7:o 

U2 

END 


IF  KIND  =  USERHOST  THEN 

GOODKINDS  :=  CLINKEDiSEGPROCSEPRTSEG.HOSTSEGfUNlTSEGD 

ELSE 

GOODKINDS  :=  CLINKED, UNITSEG.SEPRTSEGDS 

WITH  FP'^.SEGTSL  DO 
REPEAT 

INT.VAL  :=  ORD(SEGKINDCSD) ; 

IF  (INT.BYTECHIGHBYTE3  <>  0)  THEN 

BEGIN 

ERRORCBAD  BYTE  SEX»);  EXIT(LINKER) 
end: 

ALLLINKED  :=  ALLLINKED  AND  (SEGKINDCSD  =  LINKED); 
IF  (DISKINFOCSD.CODELENG  =  0) 
AND  (SEGKINDCS3  <>  LINKED)  THEN 

IF  (KIND  <>  USERHOST) 

OR  <SEGKINDCS3  <>  UNITSEG)  THEN 
ERROR( 'FUNNY  CODE  SE6» ) ; 
IF  {DISKINF0CS3.C0DELENG  <  0) 
OR  (DISKINF0CS3.C0DEADDR  <  0) 
OR  (DISKINF0CS3.C0DEADDR  >  300)  THEN 

ERR0R{*3AD  DISKINFO'); 
IF  NOT  (SEGKINDCS3  IN  GOODKINDS)  THEN 

ERROR ('BAD  SEG  KIND'); 
IF  NOT  ALPHABETIC(SEGNAMECS3)  THEN 

ERROR ('BAD  SEG  NAME*) 5 
IF  ERRCOUNT  >  ERRS  THEN 

s  :=  maxseg; 

S  ' ~    S+1 
UNTIL  S  >  MAXSEG5 
IF  ALLLINKED  AND  (KIND  =  USERHOST)  THEN 
BEGIN 

WRITECALL  SEGS  LINKED'); 
EXIT(LINKER) 
END; 
IF  ERRCOUNT  =  ERRS  THEN 
HOSTFILE  :=  FP 
END 
END 
C  SETUPFILE  D  ; 


t  OK  FILE. ..LINK  IN  D 


655 

16  :n 

0 

656 

i6:i 

0 

657 

16:2 

3 

658 

16:3 

3 

659 

16:^+ 

15 

660 

16:3 

28 

661 

16:2 

57 

662 

i6:i 

57 

663 

I6:i 

64 

G6I4 

16:2 

64 

665 

16:3 

67 

666 

16:^ 

67 

667 

16:5 

72 

668 

16:4 

07 

669 

16:5 

11 

670 

16:4 

30 

671 

16:4 

36 

672 

16:3 

56 

673 

16:2 

58 

67^ 

16:3 

60 

675 

16:4 

60 

676 

16:4 

61 

677 

16:4 

96 

678 

16:5 

05 

679 

16:6 

10 

680 

16:5 

45 

681 

16:6 

49 

682 

16:4 

68 

683 

16:4 

74 

684 

16:5 

79 

685 

16:4 

83 

686 

16:5 

01 

687 

16:6 

01 

688 

16:6 

21 

689 

16:6 

36 

690 

16:7 

45 

691 

16:6 

47 

692 

16:7 

54 

693 

16:6 

74 

694 

16:7 

78 

695 

16:5 

82 

BEGIfJ  C  3UIL0FILELIST  : 
IF  TALKATIVE  THEN 
dEGI.M 

FOR  I  :=  1  TO  7  DO 

WRITELN; 
^RITELN(  HEADER  ) 
END; 
USEwORKFILE  :=  CMDSTATE  <>  SYSPROG; 
WITH  USERINFO  DO 

IF  USEWORKFlLfc:  THEN 
3EGIN 

IF  GOTCODE  THEN 

FNAME  :=  CONCAT(COOEVID,  ':•,  CODETID) 
ELSE 

FNAME  :=  'IN  WORKSPACE'; 
SETUPFILE(0,  USERHOST,  FNAME); 
SETUPFlLEdt  SYSTEMLIB»  '♦SYSTEM, LIBRARY*  ) 
END 
ELSE 
BEGIN 

WRITECHQST  FILE?  ♦)  ; 
READLN(FNAME) ; 
IF  FNAME  =  •♦  THEN 
IF  GOTCODE  THEN 

FNAME  J=  CONCAT(CODEVIDi  •:♦»  CODETID) 
ELSE 

FNAME  :=  'IN  WORKSPACE'; 
SETUPFILE(0,  USERHOSTi  FNAME); 
IF  ERRCOUNT  >  0  THEN 

EXIT{LINKER) ;  C  NO  HOST!  1 
FOR  F  :=  1  TO  MAXFILE  00 
BEGIN 

WRITECLIB  FILE?  ')  ; 

READLN( FNAME) ; 

IF  FNAME  =  "  THEN 

GOTO  i; 
IF  FNAME  =  '*•  THEN 

SETUPFILE(F,  SYSTEMLIB,  ' *SYSTEM. LIBRARY' ) 
ELSE 

SETUPFILE{F,  JSERLIB.  FNAME) 
END; 
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4o6 


696 

697 

698 

699 

700 

701 

702 

703 

704 

705 

706 

707 

708 

709 

710 

711 

712 

713 

714 

715 

716 

717 

718 

719 

720 

721 

722 

723 

724 

725 

726 

727 

728 

729 

730 

731 

732 

733 

734 

735 

736 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


16:4 
16:4 
16:4 
16:4 
16:5 
16:6 
16:5 
16:6 
16:3 

1613 

16:3 
16:3 
16:3 
I6:i 
i6:i 
16:2 
16:2 

1612 

16:2 
I6:i 
I6:i 
i6:o 
i6:o 
i6:o 

1610 

16: 
16: 
16: 
16: 
16; 
16: 

19! 


0 
0 
0 
0 

;o 
:o 
:d 


19:d 
19:d 
19:d 
19:d 
i9:o 
i9:i 
19:2 
19:3 
19:3 


91 

91 

11 

26 

35 

47 

57 

59 

79 

79 

79 

79 

79 

79 

85 

85 

89 

92 

95 

95 

03 

07 

28 

28 

28 

28 

28 

28 

28 

28 

28 

1 

1 

1 

2 

3 

0 

0 

5 

22 

34 


i: 

WRITE( 'MAP  NAME?  ♦ ) ; 

READLN(WIAPNAME)  ? 

IF  MAPNAME  <>  •♦  THEN 

IF  MAPNAMECLENGTH(MAPNAME)a  =  •,♦  THEN 
DELETECMAPNAMEt  LENGTH (MaPNAME) »  1) 

ELSE 

hmsert( '.text*!  mapname,  length ( mapname )+l ) 
end; 

c  now  reverse  list  so  host  is  3 
c  first  and  syslib  is  last    3 

p  :=  hostfile;  hostfile  :=  nil; 

REPEAT 

Q  :=  P'^.NEXT; 
P'^.NEXT  :=  HOSTFILE; 
HOSTFILE  :=  p; 
p  :=  Q 

UNTIL  P  =  NIL; 
LI8FILES  :=  HOSTFILE'*. NEXT; 
END  C  BUILDFILELIST  1    ; 


* 
♦ 
« 
1 


BUILDSEGINFO  INITIALIZES  THE  SEGINFO  TABLE  FROM 
THE  HOST  PROTOTYPE  SEG  TABLE.   ALL  LEGAL  STATES 
ARE  CHECKEDt  AND  IMPORTED  UNITS  FOUND.   THIS 
LEAVES  A  LIST  OF  ALL  SEGS  TO  FINALLY  APPEAR  IN 
The  OUTPUT  CODE  FILE, 


PROCEDURE  BUILDSEGINFO; 
LABEL  l; 
VAR  S:  SEGINDEX; 

ERRS:  INTEGER; 

sp:  SEGP; 
BEGiig 

WITH  HOSTFILE^. SEGTBL  DO 
FOR  S  :=  0  TO  MAXSEG  DO 
IF  (SEGKINDCS3  =  LINKED) 
AND  (DISKINFOCSl.CODELENG  = 


0)  THEN 


737 

1   19;4 

47 

738 

1   19:3 

55 

739 

1   19:4 

59 

7^0 

i   19:5 

59 

741 

1   19:5 

62 

742 

1   19:5 

67 

743 

1   I9:b 

70 

744 

1   19:5 

78 

745 

1   19:5 

83 

746 

I   19:5 

97 

747 

L    19:5 

01 

748 

L    19:5 

01 

749 

I   19:5 

Q3 

750    : 

L    19:5 

03 

751 

L    19:7 

08 

752    ] 

L    19:6 

23 

753    ] 

L    19:7 

27 

754    ] 

L    19:8 

32 

755    ] 

L    19:7 

47 

756    ] 

L    19:8 

51 

757    ] 

L    19:8 

56 

758    3 

L   19:5 

56 

759    ] 

L    19:7 

61 

760    ] 

19:6 

64 

761    ] 

19:7 

68 

762    : 

19:8 

68 

763    1 

19:8 

73 

764    1 

19:8 

76 

765    1 

19:7 

76 

766    1 

19:7 

81 

767    1 

1915 

81 

768    1 

19:7 

93 

769    1 

19:7 

95 

770    1 

19:7 

04 

771    1 

19:5 

07 

772    1 

19:5 

32 

773    1 

19:6 

37 

774    1 

19:5 

45 

775    1 

19:6 

49 

776    1 

19:4 

57 

777    1 

19:4 

66 

SCGINFOCSJ  :=  NIL    C  NOT  IN  USE  ] 
ELSE 

3EGIN  C  00  SOMETHING  wITH  SEG  1 

ERRS  :=  ERRC0UNT5 

NEW(SP); 

SP'^.SRCFILE  :=  HOSTFILE; 

SP'^.SRCSEG  :=  S; 

SP'^.SYMTAB  :=  NIL; 

SP'^.SEGKIND  :=  SEGKINDCS3; 

CASE  SP'^.SEGKIND  OF 
SEGPROC, 


linked: 
hostseg: 


seprtseg: 


:   C  NOTHING  TO  CHECK!  1 

IF  S  <>  MASTERSEG  THEN 
ERR0R{»3AD  HOST  SEG») 

ELSE 

IF  HOSTSP  <>  NIL  THEN 

ERROR(»DUP   HOST    SEGM 
ELSE 

HOSTSP  :=  sp; 

IF  S  =  MASTERSEG  THEN 

SP'^.NEXT  :=  NIL 
ELSE 

BEGIN  C  PUT  INTO  SEPLIST  2 
SP-^.NEXT  :=  SEPLIST; 
SEPLIST  :=  SP{ 
sp  :=  NIL 

END; 


unitseg: 


IF  DISKINF0CS3,C0DELENG  =  Q  THEN 
SP'^.SRCFILE  :=  UNITSRCH(LlBFILESf 

SEGNAMECSJf 

SP^.SRCSES) 

END  C  CASES  1    i 

IF  ERRS  =  ERRCOUNT  THEN 

SEGINF0CS3  :=  SP 
ELSE 

SEGINFOCSJ  :=  NIL 

end; 
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-to. 


773 

L   19:'+ 

66 

113 

1   i9:if 

66 

780 

L   i9:i 

06 

781 

I   19:2 

33 

782 

L    19:3 

96 

733    : 

L   i9:i 

05 

78^ 

L   i9:i 

11 

785 

L   I9:i 

11 

786    : 

L   i9:i 

17 

787    ; 

L    19:2 

30 

788    j 

L   i9:o 

^3 

789    J 

L   i9:o 

68 

790    : 

L   i9:o 

68 

791    ] 

L   i9:o 

68 

792    ] 

L   i9:o 

68 

793    ] 

L   i9:o 

68 

79^    : 

L   i9:o 

68 

795    3 

L   i9:o 

68 

796    3 

L    1910 

68 

797    : 

L   i9:o 

68 

798    3 

L   2o:d 

1 

799    3 

L   2o:d 

1 

800    ] 

L   2o:d 

4 

801    ] 

L   2o:o 

5 

802    ] 

L   2o:o 

0 

803    1 

L   2o:i 

0 

80^    3 

L   2o:i 

3 

805    3 

L    20:2 

8 

806    3 

L    20:3 

8 

807    3 

L    20:4 

25 

308    3 

L    20:5 

39 

809    3 

L    20:6 

39 

810    3 

L    20:6 

i+l 

811    3 

L    20:6 

49 

812    3 

L    20:6 

52 

813    3 

L    20:6 

60 

81*+    3 

L    20:6 

65 

815    3 

20:6 

70 

816    I 

20:6 

75 

817    3 

20:5 

75 

818    3 

20:3 

85 

C  'JOW  FIND  FIRST  ASSIGNABLE  SEG  1 

FOR  S  :=  FIRSTSEG  TO  MAXSEG  00 
IF  SEGINFOCS:  =  NIL  THEN 
GOTO  1; 
S  :=  MAXSEGi; 

i: 

NEXTSEG  :=  s; 

IF  sEGINFOC^IAStERSEG:  =  NIL  THEN 
ERRORCWEIRD  HOST*  ) 
END  C  BUILDSEGINFO  1    ; 


* 

* 
2 


BUILDSEPLIST  SEARCHES  THROUGH  LIBRARIES  AND  ADDS  ONTO 
A  GLOBAL  LIST  OF  SEP  SEGS  THAT  ARE  TO  BE  SEARCHED 
FOR  PROCS  AND  GLOBALS.   THEY  ARE  INITIALLY  BUILT  IN 
The  REVERSE  ORDER,  THEN  REVERSED  AGAIN  SO  SEARCHES 
WILL  GO  IN  THE  ORDER  THE  FILES  WERE  SPECIFIED. 


PROCEDURE  BUILDSEPLIST? 

VAR  sp,  p,  q:  SEGP; 
fp:  FINFOP; 
S:  SEGINDEX; 
BEGIN 

FP  :=  LIBFILES; 
WHILE  FP  <>  NIL  DO 
BEGIN 

FOR  S  :=  0  TO  MAXSEG  00 

IF  FP'^.SEGTBL.SEGKINDCSD  =  SEPRTSEG  THEN 
BEGIN 


NEW(SP) 5 

SP^.NEXT  :=  SEPLIST; 

SP'*,SRCFILE 

SP'^.SRCSEG 

SP'^.SYMTAB 

SP'^.SEGKIND 

SP'^.NEXT  :=  SEPLIST; 

seplist  :=  sp 

end; 

FP  :=  FP'^.NEXT 


:=  Fp; 

=  s; 
=  nil; 

:=  SEPRTSEG; 


819  1  20:2  66                         rrjD; 

320  1  20:2  31 

^21  1  20:2  91                    c    NO^    REVERSE    THE    LIST    TO    VIAINTAIN    ORIGINAL    ORDER    3 

322  1  20:2  91 

'^^s  1  20:1  91      p  :=  seplist;  seplist  :=  nil; 

824  1  20:1  97        WHILE  P  <>  NIL  DO 

825  1  20:2  02.         3EGIN 

826  1  20:3  02            Q  :=  P-,N£XT; 

827  1  20:3  06            P'^.NEXT  :=  SEPLIST; 
8^8  1  20:3  11            SEPLIST  :=  P5 

829  1  20:3  m        p  :=  Q 

830  1  20:2  14          END 

831  1  20:0  17      END  C  3UILDSEPLIST  1    ; 

832  1  20:0  38 

833  1  1510      0  BEGIN  C  PHASEl  2 

834  1  15:0      0 

835  1  15;o      0    C  INITIALIZE  GLOBALS  2 

836  1  15:0      0 

837  1  15:i      0    HOSTFILE  :=  NIL; 

838  1  15:i      3    LIBFILES  :=  NIL; 

839  1  15:i      6    HOSTSP  :=  NIL; 

8'*o  1  15:1    9   SEPLIST  :=  nil; 

S**!  1  15:i  12    REFLITYPES  :=  CUNITREF,  GLObREFi  PUBLREF» 

842  1  15:1  12                  PRIVREF.  CONSTREF. 

843  1  15:1  12                  SEPPREF,  SEPFREFD; 

844  1  15:1  20    ERRCOUNT  !=  O; 

845  1  15:1  23    NEXTBASELC  :=  3; 
8^+6  1  15:1  31    MAPNAME  :=  ••; 

8'*7  1  15:1  38    TALKATIVE  :=  NOT  USERINFO.SLOWTERM; 

848  1  15:i  44    MARK(HEAPBASE); 

849  1  15:i  48    UNITWRITE(3«  HEAPBASE",  35); 

850  1  15:1  56 

851  1  15:1  56    C  DETERMINE  BYTE  SEX  OF  MACHINE  J 

852  1  15:i  56 

853  1  15:i  56    FLIPPED  :=  FALSE; 

854  1  15:1  60   int.val  :=  i; 

855  1  15:i  63    HIGHBYTE  :=  ORD(  INT.BYTECOJ  =  1  ); 

856  1  15:1  77 

857  1  15:1  77    C  BUILD  LIST  OF  INPUT  FILES  J 

858  1  15;i  77 

859  1  15:1  77    BUILDFILELIST; 
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430 


860 
8q1 
862 

863 

66^ 

865 
866 
867 
868 
869 
870 
871 
872 
873 
874 
875 
876 
876 
877 
878 
879 
880 
881 
882 
883 
884 
885 
886 
887 
888 
889 
890 
891 
892 
893 
894 
895 
896 
897 
898 
899 


1 
1 
1 


15 
15 
15 
15 
15 
15:i 

i5:i 
15:2 
15:2 
15:2 
15:2 
I5:i 
i5:i 
15:2 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
i5:o 
15: 0 
i5:o 
2i:d 
2i:d 
2i:d 


79 
84 
88 
88 
38 
88 
90 
95 
99 
99 
99 
99 
01 
06 
10 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
1 
1 
2 


IF  ERRCOUNT  >  0  THEN 
EXIT(LINKER) ; 

C  INIT  3ASIC  SEG  INFO  TABLE  3 

BUILDSEGINFO; 
IF  ERRCOUNT  >  0  THEN 
EXIT(LINKER); 

c  finally  build  sep  seg  list  2 

buildseplist; 

if  errcount  >  0  then 

EXIT(lINKER) 
END  C  PHASEl  3  5 

C$1  LINKl  : 
C$1  LINK2  1 

( ♦♦*♦♦****♦***♦♦♦♦****♦♦♦♦*♦******♦***♦**»********♦****************) 
(«  *) 

(*  COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.  *) 
(*  PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-  *) 
(*  TATION  in  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE  *) 
(*   OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS.  *) 

(*  *) 

(*****♦***♦****♦********♦♦*****♦******♦*****♦*****♦*****♦****♦***♦*) 


PHASE2  READS  IN  ALL  LINKER  INFO  ASSOCIATED  WITH 
THE  SEGS  in  SEGINFO  AND  SEP  SEG  LIST,   AGAIN  ALL 
FIELDS  ARE  CHECKED  CAREFULLY.   AS  A  HELP  TO  PHASE3, 
REF  LISTS  ARE  COLLECTED  AND  PLACE  RECORDS  FOR  SEP 
PROC/FUNC  ARE  COMPUTED.   SOME  SMALL  OPTIMIZATION  IS 
DONE  TO  ELIMINATE  THE  SEP  SEG  LIST  IF  IT  IS  NOT 
GOING  TO  BE  NEEDEDt  SAVING  A  FEW  DISK  ID'S, 


PROCEDURE  PHASE2; 
VAR  S:  SEGINDEX; 

SP:  SEGP; 
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DUvipSEPS:     BOOLEAN; 


reaolinkinfo  reads  in  the  link  info  for  segment  sp 
a.md  builds  its  symtab.  some  simple  disk  10  routines 
00  unblocking,  and  all  fields  are  again  verified. 
The  only  legal  litypes  are  in  oktypes.  assume  that 

SP  0  NIL 


PROCEDURE  REA0LINKINF0(SP:  SEGP;  OKTyPESJ  LISET); 

var  rp,  rq:  refp' 
syp:  symp; 

W.  ERRSi  NRECS,  NEXTBLK,  RECSLEFT:  INTEGER; 

ENTRY*  temp:  lientry; 

BUF:  ARRAY  CO. .313  OF 

ARRAY  CO. .73  OF  INTEGER; 
TENTRY:  ARRAY  CO. .73  OF  INTEGER; 


*  GETENTRY  READS  AN  8  WORD  RECORD  FROM  DISK  BUF 

*  SEQUENTIALLY.   NO  VALIDITY  CHECKING  IS  DONE  HEREt 

*  ONLY  DISK  READ  ERRORS. 
3 

PROCEDURE  GETENTRY(VAR  ENTRY:  LIENTRY); 

VAR  err:  BOOLEAN? 
BEGIN 

ERR  :=  FALSE? 
IF  RECSLEFT  =  0  THEN 
BEGIN 

RECSLEFT  :=  32; 

ERR  :=  BLOCKREADCSP-.SRCFILE'^.CODE*,  BUF.  1,  NEXTBLK)  <>  1; 
IF  ERR  THEN 

ERRORCLI  READ  ERR») 
ELSE 

NEXTBLK  :=  NEXTBLK+1 
END; 

M0VELEFT(BUFC32-RECSLEFT3,  ENTRY.  16); 
IF  ERR  THEN 

ENTRY. LITYPE  :=  EOFMARK; 
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32 

RECSLEFT    :=    RECSLEFT-1 
EiMO    C    GETENTRY    D    ; 


* 
3 


ADDUNIT  IS  CALLED  TO  FIND  OR  ALLOCATE  A  LIBRARY  UNIT 
THAT  IS  FOUND  IN  LINK  INFO  AS  AN  EXTERNAL  REF.   THIS 
OCCURS  IN  LIB  UNITS  WHICH  USE  OTHER  UNITS.   IF 
THE  UNIT  CAN'T  BE  FOUND  OR  NO  ROOM,  ERROR  IS  CALLED, 


PROCEDURE  ADDUNIT(VAR  NAME:  ALPHA); 

VAR  fp:  finfop;  seg:  integer; 

3EGIN 

FP  :=  UNITSRCH(H0STFILE,  NAME*  SEG); 
IF  FP  <>  NIL  THEN 

IF  FP  <>  HOSTFILE  THEN 

IF  FP'^.SEGTBL.DISKINFOCSEGD.CODELENG  <> 
IF  NEXTSEG  =  MAXSEGl  THEN 

ERROR(»NO  ROOM  IN  SEGINFOM 
ELSE 

BEGIN  C  ALLOCATE  NEW  SEGINFO  EL  3 
NEWCSEGINFOCNEXTSEGl) ; 
WITH  SEGINFOCNEXTSEG]'^  DO 
BEGIN 

SRCFILE  :=  FPJ 
SRCSEG  :=  SEG; 
SEGKIND  :=  unitseg; 

SYMTAB  :=  NIL 
END; 
NEXTSEG  :=  NEXTSEG+1 
END 
END  C  ADDUNIT  3  ; 


0  THEN 


* 
* 


VALIDATE  VERIFIES  LIENTRY  FORMAT, 

IF  THE  ENTRY  IS  SEPPROC  OR  FUNC 

THEN  A  PLACE  REC  IS  ALLOCATED  FOR  BUlLDPLACE,   IF 

A  UNITREF  IS  FOUND,  IT  SEARCHED  FOR  AND  POSSIBLY 

ALLOCATED,   IF  THE  UNIT  MUST  BE  ADDED  TO  SEGINFO, 

IT  IS  PLACED  AFTER  CURRENT  POSITION  SO  IT  WILL  HAVE 

ITS  LINK  INFO  READ  AS  WELL. 
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23 
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23 

PROCEDURE  VALIDATE(VAR  ENTRY:  LlEr^TRY); 
3EGIN 

WITH  ENTRY  DO 
IF  NOT  ALPHABE 
ERROR( 'NON-A 
ELSE 

CASE  LITYPE 
SEPPREF, 
SEPFREF, 
UNITREFt 
GLOBREF, 
PUBLREF, 
PRIVREF, 
CONSTRtF: 


:tic{name)  then 

iUPHA  NAME') 
OF 


globdef: 


PU8LDEF: 


EXTPROC, 

extfunc, 

SEPPROC. 


BEGIN 

REFLIST  :=  HIH 

IF  (NREFS  <  0) 

OR  (NREFS  >  500)  THEN 

ERROR(»TOO  MANY  REFS»)J 
IF  NOT  (FORMAT  IN  CWORD,  BYTEf 

ERRORCBAD  FORMAT»)! 
IF  LITYPE  =  PRIVREF  THEN 

IF  (NWORDS  <s  0) 

or  (nwords  >  maxlc)  then 
error(»bad  private*); 
if  litype  =  unitref  then 
if  nrefs  <>  0  then 
adounit(name) 
end; 

<=  0) 

>  MAXPROC) 
<  0) 

>  MAXIC)  THEN 
GLOBOEFM  ; 

IF  (BASEOFFSET  <=  0) 
OR  (BASEOFFSET  >  MAXLC)  THEN 
ERROR(»BAD  PUBLICDEFM; 


8X63)  THEN 


IF  (HOMEPROC 
OR  (HOMEPROC 
OR  (ICOFFSET 
OR  (ICOFFSET 
ERROR(»BAD 
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SEPFUNC: 


END  C  CASE 
END  C  VALIDATE  1 


BEGIN 

IF  LITYPE  IN 
NEW (PLACE) 
ELSE 

PLACE  :=  NIL; 
IF  (SRCPROC  <=  0) 
OR  (SRCPROC  >  MAXPROC) 
OR  (NPARAMS  <  0) 
OR  (NPARAMS  >  100)  THEN 
ERRORCBAD  PROC/FUNCM 
END 
LITYPE  D 


CSEPPROCfSEPFUNCD  THEN 
C  FOR  USE  IN  BUILDPLACES 


BEGIN  C  READLINKINFO  1 

RECSLEFT  :=  0;       C  8  WD  RECS  LEFT  IN  BUF  3 
WITH  SP'^.SRCFlLE'^.SEGTBLi  DISKINFOCSP^.SRCSEGD  DO 
BEGIN  C  SEEK  TO  LINKINFO  1 

NEXTBLK  :=  CODEADDR  ♦  (C0DELEN6+5H )  DIV  512« 
IF  TALKATIVE  THEN 

WRITELN(  ♦READING  •»  SEGNAMECSP'".SRCSEG3) 
END? 
REPEAT 

GETENTRY(ENTRY)5 

IF  FLIPPED  THEN  C  FLIP  WORD  QUANTITIES  IN  LIENTRY  3 

BEGIN 

moveleft(entry,  tentry.  16)1 
for  w  :=  1  to  7  do 

byteswap(TEntry:wd) ; 
moveleft(tentryf  entry*  16); 
end; 

errs  :=  errcount; 
if  entry. litype  <>  eofmark  then 
if  entry. litype  in  oktypes  then 
validate(entry) 

ELSE 
BEGIN 

ERROR(»BAD  LITYPE») { 
ENTRY. LITYPE  :=  EOFMARK 

END; 
IF  DUMPSEPS  THEN 
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IF  E-ntry.litype:  in  cseppref,  sepfref, 

EXTPROC,  EXTFUNC 
GL03REFJ  THEN 
DUMPSEPS  :=  FALSE;   C  WE  NEED  THEM!  1 

IF  eijtry.litype  in  reflitypes  then 

BEGIN  C  READ  REF  LIST  3 

NRECS  :=  (ENTRY. NREFS+7)  DIV  8; 

while  nrecs  >  0  do 
begin  c  read  ref  rec  1 
getentry(temp) ; 

NEW(RP); 

M0VELEFT(TEMP,  RP-^tREFS,  16); 
IF  FLIPPED  THEN  C  FLIP  REF  WORDS  D 
FOR  W  :=  0  TO  7  00 

BYTESWAP(RP*,REFSCW3) ; 
RP^.NEXT  ;=  ENTRY, REFLIST; 
ENTRY. REFLIST  :=  RP; 
NRECS  :=  NRECS-1 
END; 
C  REVERSE  REF  LIST  3 
RP  :=  ENTRY. REFLIST; 
ENTRY. REFLIST  :=  NIL; 
WHILE  RP  0  NIL  DO 
BEGIN 

RQ  :=  rp-^.next; 

RP'^.NEXT  :=  ENTRY. REFLIST; 
ENTRY. REFLIST  :=  RP; 
RP  :=  RQ 

END 
END; 
IF  ENTRY. LITYPL  =  EOFMARK  THEN 
IF  SP'^.SEGKIND  =  HOSTSEG  THEN 
IF  (ENTRY. NEXTLC  >  0) 
AND  (ENTRY. NEXTLC  <=  MAXLC)  THEN 

NEXTBASELC  :=  ENTRY. NEXTLC 
ELSE 

ERROR(»BAD  HOST  LCM 
ELSE 
ELSE 

IF  ERRS  =  ERRCOUNT  THEN 

BEGIN  C  OK. ..ADD  TO  SYMTAB  2 
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rjEW(SYP)  J 

SYP'^.CfjTHY  :=  entry; 

ENTERSYM(SYPt  SP'^.SYMTAB) 
END 
JNTIL  ENTRY. LITYPE  =  EOPMARK 
JD  C  REAOLINKINFO  ]  ; 


BUILDPLACES  READS  CODE  OF  SEP  SEGS  FROM  DISK  TO  GENERATE 
THE  PLACEREC  ENTRIES  FOR  USE  DURING  PHASES.   THE  SEG  IS 
READ  INTO  THE  HEAP  AND  THE  GROSSNESS  BEGINS.  ASSUME  THAT 
SP  0  NIL 


PROCEDURE  BUILDPLACES{SP:  SEGP); 
VAR  CP:  CODEP;  HEAP:  ^INTEGER; 

NBYTES.  NBLOCKSt  NPROCS*  N:  INTEGER; 
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1: 

* 

* 
2 


PROCSRCH  RECURSIVLY  SEARCHES  SYMTAB  OF  SP  TO  FIND 
SEPPROC  AND  SEPFUNC  ENTRIES  AND  BUILD  THE  ACTUAL 
PLACE  RECORD  FOR  THE  LINK  INFO  ENTRY  BY  INDEXING 
THRU  PROC  DICT  TO  JTAB  AND  USING  ENTRIC  FIELD. 


SYMP) 


PROCEDURE  procsrch(symtab: 
VAR  I,  j:  integer; 

BEGIN 

IF  SYMTAB  0  NIL  THEN 
BEGIN 

PROCSRCH(SYMTAB*.LLINK) ; 
PROCSRCHCSYMTAB-^.RLINK)  ; 
PROCSRCHCSYMTAB'*. SLINK)  ; 
WITH  SYMTAB'". ENTRY  DO 

IF  LITYPE  IN  CSEPPROCt  SEPFUNC3 
IF  (SRCPROC  <=  0)  OR  (SRCPROC 

ERKOR{»BAD  PROC  ttM 
ELSE  C  FIND  BYTE  PLACE  IN  CODE  3 
BEGIN 

I  :=  NBYTES-2-2*SRCPR0C; 
I  :=  I-FETCHWORDCCP,  I); 


THEN 

>  NPROCS) 


THEN 


POINT 
POINT 


AT 
AT 


PROC  DICT  1 
JTAB  3 
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82 

IF  {FETCH3YTE(CP.  I)  <>  SRCPROC) 
AND  (FETCHBYTE(CP,  I)  <>  0)  THEN 

ERROR( 'DISAGKEEING  P  #•) 
ELSE 
BEGIN 

J  :=  FETCHWORD(CP»  I-2)+4; 

PLACE'^.SRCBASE  :=  I+2-j; 

IF  (PLACE'^.SRCBASE  <  0) 

OR  (J  <=  0)  OR  (J  >  MAXIC)  THEN 

ERROR(»PROC  PLACE  ERR') 
ELSE 

PLACE*^, LENGTH  :=  J 
END 


END 


END 
END 
C  PROCSRCH  ; 


BEGIN  C  BUILDPLACES  3 

NBYTES  :=  SP'^.SRCFILE'^.SEGTBL.DISKINFOCSP'^.SRCSEG^.CODELENG} 
NBLOCKS  :=  (NBYTES+511)  DIV  512; 
IF  MEMAVAIL-400  <  NBL0CKS*256  THEN 

ERROR{»SEP  SEG  2  BIGM 
ELSE 

BEGIN  C  ALLOC  SPACE  IN  HEAP  1 
MARK (HEAP)  ; 
N  :=  NBL0CKS5 
REPEAT 
NEW(CP) ; 
N  :=  N-1 
UNTIL  N  <=  0! 
IF  BLOCKREaD(SP'*,SRCFILE'^,CODE'*,  HEAP**.  NBLOCKS, 

SP-.SRCFILE'^.SEGTBL.DISKINFOCSP'^.SRCSEGJ.CODEADDR) 
ERR0R(»SEP  SEG  READ  ERR') 
ELSE 
BEGIN 

CP  :=  GETCODEP(0RD(HEAP)) ; 

NPROcs  :=  fetchbyte(cp,  nbytes-d; 

IF  (NPROCS  <  0)  OR  (NPROCS  >  MAXPROC)  THEN 

ERROR( 'BAD  PROC  DICT') 
ELSE 

PROCSRCH  (SP-^.SY^ITAB) 


<>  NBLOCKS  THEN 
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:98 


1137 
1180 
1189 
1190 
1191 
1192 
1193 
1194 
1195 
1196 
1197 
1198 
1199 
1200 
1201 
1202 
1203 
1204 
1205 
1206 
1207 
1208 
1209 
1210 
1211 
1212 
1213 
1214 
1215 
1216 
1217 
1218 
1219 
1220 
1221 
1222 
1223 
1224 
1225 
1226 
1227 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 


26 

26 

26 

26 

26 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21:3 

21:3 

21 

21 

21:3 

21:4 

2i;3 

21:4 

21:3 

21:3 

21:3 

21:3 

21:3 

21:1 

21:2 

21:1 

21 

21 

21 

21 

21 


:4 

:2 
:o 
:o 
:o 
:o 
;i 
;i 
;i 
;i 
ii 
;i 
:i 

12 


:3 
:4 


21:2 
21:2 
21:2 
21:1 
21:2 


84 
86 

ee 

90 
06 
0 
0 
0 
4 
12 
12 
12 
12 
15 
32 
45 
57 
59 
68 
78 
87 
97 
06 
16 
31 
59 
59 
59 
59 
62 
65 
68 
73 
73 
85 
86 
91 
91 
91 
91 
05 


end; 
release(heap) 

END 

end  c  buildplace5  ^  5 

begin  l  phase2  1 

mark(heapbase) ; 
unitwrite(3«  heapbase'^f  35)5 

C  READ  LINK  INFO  FOR  HOST  SEGS  D 

DUMPSEPS  :=  true;      C  assume  we  DON'T  NEED  SEP  SEGS  3 
FOR  S  :=  0  TO  MAXSEG  DO 

IF  SEGlNFOESD  <>  NIL  THEN 

CASE  SEGINFOCSn^'SEGKIND  OF 

linked:    ;  c  nothin  i  ^  ^ 

UNITSEG:    READLINKINF0(SEGINF0Cs3»  CPUBLREFt  PRIVREF.  UNITREF, 
^                                   CONSTDEF.EXTPROC,  EXTFUNC3)1 

SEPRTSEG:   READLINKINF0{SEGINF0CS3.  CGLOBREFt  GLOBDEFf  CONSTDEFt 

SEPPROCi  SEPFUNC3)? 

HOSTSEG:    READLINKINF0(SEGINF0CS3.  cpubldef,  CONSTDEF. 

EXTPROC,  EXTFUNC3); 

SEGPROC:    REA0LINKINF0(SEGINF0CS3.  CEXTPROC.  EXTFUNC3) 
END  C  CASES  1    ! 

C  NOW  00  SEP  LIST  ELEMENTS  2 

IF  DUMPSEPS  THEN 

SEPLisT  :=  nil; 
sp  :=  seplist; 
while  sp  o  nil  do 

REaDLINKINFO{SPi  REFLITYPES+CGLOBDEF*  CONSTDEF.  SEPPROC.  SEPFUNC]) 

sp  :=  sp^.next 

end; 

C  BUILD  PROC  PLACE  ENTRIES  FOR  SEP  SEGS  1 

IF  SEGInFOCMASTERSEGD'^.SEGKIND  =  SEPRTSEG  THEN 
BUILDPLACES(SEGINFOCMaSTERSEGD) ; 


1223  1  2i:2  16 

1229  1  2i:i  lb   sp  :=  seplist; 

1230  1  21 :i  19    WHILE  SP  <>  NIL  DO 

1231  1  21:2  24      SESIN 

1232  1  21:3  2*+        BUIlDPlACESCSP)  ; 

1233  1  21:3  27        SP  :=  SP-.fJEXT 

1234  1  21:2  26      end; 

1235  1  2i:i  33    IF  ERRCOUNT  >  0  THEN 

1236  1  21:2  58      EXIKlINKER) 

1237  1  21:0  42  END  C  PHASE2  1    \ 
1233  1  21:0  60 

1239  1  21:0  60  C$1  LINK2  2 

1239  1  21:0  60  CSI  Llf\lK3A  J 

1240  1  21:0  60 

}^^l  ""■  ^^'^  ^°      (******************♦*****************♦*♦**♦*******♦♦♦♦*♦***♦♦*♦♦♦♦*) 

1242  1  21:0  60      {*                                                                     ' 

Jouf  I  !^*°  ^°      ^*      COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.    *) 

noap  i  !J*°  ^°      ^*   PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-     *) 

ioa!  ,  1:'°  ^°      **   TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE    *) 

1246  1  21:0  60      (*   OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS,          *) 

1247  1  21:0  60      (♦                                                                 ^j 

\olt  ^  ^^l^  ^°      <*******************♦*************♦********♦***♦****♦***♦♦»♦♦*♦*#♦#) 

1249  1  21 1 0  60 

1250  1  21:0  60  C 

1251  1  21:0  60  *   PHASE3  OF  THE  LINKER  DOES  ALL  THE  REAL  WORK  OF  CODE 

1252  1  21:0  60  ♦   MASSAGING.   FOR  EACH  SEGMENT  IN  SEGINFO  TO  BE  PLACED 

1253  1  21:0  60  ♦   INTO  THE  OUTPUT  CODE  FiLEi  ALL  REFERENCED  PROCEDURES 

1254  1  21:0  60  *   AND  FUNCTIONS  ARE  FOUNDi  GL03ALS  AND  OTHER  REFS  ARE 

1255  1  21:0  60  *   RESOLVED*  AND  FINALLY  THE  FINAL  CODE  SEGMENT  IS  BUILT. 

.lit  ^  ^^*°  ^°  *   ^^  "^^^   ^'^^^    ^^    '^    SEPRTSEG  HOST  (EG  AN  INTERPRETER),  THEN 

1257  1  2i:o  60  *   ALL  THE  PROCS  IN  IT  ARE  PUT  IN  THE  UNRESOLVED  LIST  AND 

1258  1  21:0  60  ♦   THE  HOST  SEG  IS  MADE  TO  APPEAR  AS  JUST  ANOTHER  SEP  SEG. 

1259  1  21:0  60  ♦   THIS  DRAGS  ALONG  ALL  THE  ORIGINAL  PROCEDURES  AND  MAINTAINS 
12o0  1  21:0  60  *   THEIR  ORIGINAL  ORDERING  FOR  POSSIBLE  ASECT  INTEGRITY, 

1261  1  21:0  60  2 

1262  1  21:0  60 

1263  1  2a:D      1  PROCEDURE  PHASE35 

1264  1  28:d      1    TYPE 

llt^  }  ^?*'^  ^        ^'°^^^  =  -^WORKREC;          C  ALL  SEG  WORK  IS  DRIVEN  BY  THESE  LISTS  3 

1266  1  28:d  1        WORkREC  =  RECORD 

1267  1  28:d  1                    next:  WORKP;           C  LIST  LINK  D 
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1266 

1269 

1270 

1271 

1272 

1273 

1274 

1275 

1276 

1277 

1278 

1279 

1280 

1281 

1282 

1283 

1284 

1285 

1286 

1287 

1288 

1289 

1290 

1291 

1292 

1293 

1294 

1295 

1296 

1297 

1298 

1299 

1300 

1301 

1302 

1303 

1304 

1305 

1306 

1307 

1308 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


28:q 
2b  :d 
28  :d 
28:d 


28 
26 
26 
28 

28:o 

28:d 

28:d 

28:d 

28  :d 

28:d 

28:d 

28:o 

28:d 

28:d 

28:o 

28:d 

28:d 

26:d 

28:d 

28  :o 

28:d 

28:d 

28:d 

28:d 

28  :d 

28;d 

28:d 

28:d 

28:d 

28:d 

2a;D 

28:d 

28:d 

28  :d 

28:d 

28:d 

28:d 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

X 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

2 
3 

3 

5 

5 

5 

5 

5 

5 

11 

12 

32 

88 

89 

89 

69 

89 

69 

69 


VAR 


REFSYM,  C  SY 

OEFSYWl:  SYMP;  C 

REFStG,  C  SE 

defseg:  segp;       :  se 
case  litypes  of      c  sa 

SEPPREF, 
SEPFRlF, 

globref: 

(DEFPROC: 
UNITREF: 

(defsegnum: 
privref: 

(newoffset: 

EXTPROCf 
EXTFUNCt 
SEPPROC, 

sepfunc: 

(NEEDSRCH:  BOOLEAN? 
NEWPROC:  0..MAXPROC 
END  C  WORKREC  1    I 


3  JJ 

MTAB  ENTRY  OF  UNRESOLVED  NAME  1 
"       "    "   RESOLVING  ENTRY  ] 
G  REFLS  POINT  INTOi  REFRaNGE  ONLY 
G  WHERE  DEFSYM  WAS  FOUND  3 
ME  AS  LITYPE  IN  REFSYM^. ENTRY  3 


WORKP);        C  WORK  ITEM  OF  HOMEPROC  1 
SEGRANGE);   C  RESOLVED  SEG  tt,  DEF  =  REF  1 
LCRANGE);    C  NEWLY  ASSIGNED  BASE  OFFSET  D 


C  REFS  HAVEN»T  BEEN  FOUND  2 
)         C  PROC  »f  COMP  OR  LINK  CHOSEN 
C  0  IMPLIES  ADDED  PROC  1 


S:  SEGINDEX; 

segbase:  CODEP;  c 

segleng*  c 

NEXTBLK:  INTEGER'  C 

UPROCSt  C 

PROCS.  C 

UL3CAL,  C 

LOCAL,  C 

UOTHER,  c 

other:  workp;  c 

sephost;  boolean;  c 
fname:  stringc39J;[: 

segt3l:  i5segtbl5  c 

map:  text;  c 


ADDRESS  OF  CURRENT  SEG  BEING  CRUNCHED  2 

FINAL  CODE  SEG  LENGTH  FOR  WRITEOUT  3 

NEXT  AVAILABLE  OUTPUT  CODE  BLOCK  3 

UNRESOLVED  EXTERNAL  PROC/FUNC  WORK  LIST  2 

RESOLVED  LIST  OF  ABOVE  ITEMS  2 

UNRESOLVED  LIST  OF  UPDATES  FOR  SEGINFO  ENTRY  2 

RESOLVED  LIST  OF  FIXUPS  THAT  CAME  ALONG  WITH  SEG  2 

UNRESOLVED  WORK  LIST  OF  THINGS  OTHER  THAN  PROCS  2 

RESOLVED  LIST  OF  ABOVE  2 

FLAG  FOR  INTERPRETER  HOST  CASE  (ONLY  SEG  «1)  2 

OUTPUT  CODE  FILE  NAME  2 

OUTPUT  CODE»S  SEG  TABLE  2 

MAP  TEXT  OUTPUT  FILE  2 


C 

* 
* 
* 
* 


BUILDWORKLISTS  IS  CALLED  FOR  ALL  SEGMENTS  WHICH  NEED  TO 
BE  COPIED,  AND  MAYBE  NEED  TO  HAVE  SEPPROCS  OR  OTHERS  STUFF 
FIXED  UP  WITHIN  THEM.   THE  IDEA  HERE  IS  TO  GET  A  LIST 
OF  PROCS  AND  OTHER  ITEM  NEEDING  ATTENTION,  WITH 


1309 

1310 

1311 

1312 

1313 

13m 

1315 

1316 

1317 

1318 

1319 

1320 

1321 

1322 

1323 

132'+ 

1325 

1326 

1327 

1328 

1329 

1330 

1331 

1332 

1333 

133f 

1335 

1336 

1337 

1338 

1339 

1340 

1341 

1342 

1343 

1344 

1345 

1346 

1347 

1348 

1349 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


23 

:o 

23 

:d 

28 

:d 

28 

:o 

26 

•  u 

28 

:o 

28 

:d 

28 

:o 

28 

:d 

28 

:d 

28 

:d 

29 

:d 

29 

ID 

29 

:d 

29 

:d 

29 

:d 

29 

!D 

29 

:d 

29 

;d 

29 

:d 

29 

:d 

29; 

.D 

29! 

.0 

3o; 

.0 

30! 

;o 

30! 

'0 

30! 

0 

30! 

D 

301 

0 

3o: 

D 

30: 

D 

3o: 

0 

3i: 

D 

3i: 

D 

3i: 

0 

3i: 

1 

3i: 

2 

31 : 

3 

3i: 

3 

31. • 

3 

3i: 

3 

59 

89 

89 

39 

89 

39 

39 

89 

69 

89 

39 

1 

1 

2 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

5 

6 

6 

6 

6 

6 

6 

6 

1 

2 

0 

0 

5 

5 

9 

13 

17 


* 
* 

J 


All  TflE  SUBTLE  IMPLICATIONS  OF  GLOBAL  DEFS  FALLING 
If'J  PROCS  WHICH  ARE  NOT  YET  SELECTED  FOR  LINKING  ETC. 
In  FACT,  THREE  LISTS  ARE  3UILT: 

THE  PROCS  LliJT  ifJITH  ALL  PROCS  AND  FUNC  TO  BE  GRABBED 
FROM  THE  VARIOUS  SEP  SEGS. 

THE  LOCAL  LIST  OF  REFS  IN  THE  ORIGINAL  SEGMENT  WHICH  MUST 
UP  SUCH  AS  PUBLIC  OR  PRIVATE  REFS  IN  A  UNIT  SEG, 
LIST  WHICH  HAS  WORK  ITEMS  WHICH  HAVE  AT  LEAST  ONE 
IN  THE  PROCS  OR  FUNCS  IN  THE  PROCS  LIST. 


ALL  BE  FIXED 

THE  OTHER 

REF  OCCURING 


PROCEDURE 
VAR  SP: 

wp: 


BUILDWORKLISTS; 

SEGP; 

WORKP; 


* 

* 

♦ 
1 


FINDPROCS  goes  THROUGH  SYMTAB  AND  BUILDS  A  LIST  OF 
PROCEDURE  AND  FUNCTIONS  WHICH  OCCUR  IN  THE  TREE  AND 
WHOSE  LITYPE  IS  IN  THE  OKSET.   THE  RESULTING  LIST 
IS  NOT  ORDERED  IN  ANY  PARTICULAR  FASHION.   IT  IS 
CALLED  TO  BUILD  INITIAL  UPROC  LIST. 


FUNCTION  FINdPROCS(OKSET:  LISET;  SYMTAB:  SYMP):  WORKP; 
VAR  work:  WORKP; 

c 

*  PROCSRCH  RECURSIVLY  SEARCHES  SUBTREES  TO  PICK  OUT 

*  THOSE  SYMBOLS  WHICH  ARE  IN  THE  OKSET*  GENERATES 

*  NEW  WORK  NODES,  AND  PUTS  THEM  INTO  LOCAL  WORK  LIST, 
J 

PROCEDURE  PR0CSRCH(SYM:  SYMP); 

VAR  wp:  WORKP; 
BEGIN 

IF  SYM  <>  NIL  THEN 
BEGIN 

PR0CSRCH(SYM'*.LLINK)  ; 
PROCSRCH(SYM'*.RLINK)  ; 
PROCSRCHCSYM'". SLINK)  ; 
IF  SYM*^, ENTRY. LITYPE  IN  OKSET  THEN 
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J I 


33 


1350 

am- 

2o 

1351 

3i:5 

26 

1352 

3i:5 

31 

1353 

3i:5 

06 

135'+ 

3i:5 

^+1 

1355 

3i:5 

"+6 

1356 

3i:5 

51 

1357 

3115 

56 

1358 

3i:6 

61 

1359 

3i:5 

64 

1360 

31:6 

73 

1361 

3115 

65 

1362 

3i:5 

90 

1363 

3i:4 

90 

1364 

31:2 

94 

1365 

3i:o 

94 

1366 

31  :o 

06 

1367 

3o:o 

0 

1368 

3o;i 

0 

1369 

30:1 

3 

1370 

30:1 

6 

1371 

30:0 

6 

1372 

3o:o 

22 

1373 

30:0 

22 

137'+ 

30:0 

22 

1375 

30:0 

22 

1376 

30  :o 

22 

1377 

3o:q 

22 

1378 

30:0 

22 

1379 

3o:o 

22 

1380 

30:0 

22 

1381 

3o:o 

22 

1382 

32:d 

1 

1383 

32:d 

1 

1384 

32:d 

3 

1385 

32:d 

4 

1386 

32:d 

4 

1387 

32:0 

4 

1388 

32:d 

4 

1389 

32  :d 

4 

1390 

32:d 

4 

sym; 
nil; 
nil; 
nil; 
=  true; 


BEGIN  C  PLACE  NEW  NODE  IN  LIST  2 
NEW(WP) ; 
WP'^.REFSYM 
WP'^.REFSES 
WP'^.DEFSY'wi 
WP'^.DEFSEG 
WP'^.NEEDSRCH 
IF  SEPHOST  THEN 
WP'^.NEWPROC  :=  0 

ELSE 

WP'^.NEWPROC  :=  SYM*. ENTRY. SRCPROC; 

wp'^.NEXT   :=  wiork; 

WORK    :=    WP 
END 


C  SEE  READSRCSE6!  1 


END 
END  C  PROCSRCH  ! 

3EGIN  Z    FINDPROCS  2 
WORK  :=  NIL? 
PROCSRCH(SYMTAB) 5 
FINDPROCS  ;=  WORK 

END  C  FINDPROCS  3  5 


* 
* 
* 

♦ 
♦ 


FINDNEWPROCS  IS  CALLED  TO  PLACE  NEW  PROCEDURES  INTO  THE 
UPROCS  WORK  LIST  THAT  ARE  NEEDED  TO  RESOLVE  GLOBDEFS* 
SEPPREFS,  AND  SEPFREFS.   THE  OTHER  LIST  IS  TRAVERSED  AND 
FOR  EACH  ELEMENT  WHOSE  DEFINING  PROC  HAS  NOT  BEEN  ADDED 
INTO  THE  uPROCS  LIST,  THE  DEFINING  PROC  IS  LOCATED  AND 
ADDED  INTO  UPROCS. 


PROCEDURE  FINDNEWPROCS; 
VAR  WPt  WPi:  WORKP; 
PNUM:  INTEGER; 

c 

*  FINDNAOU  FINDS  THE  PROCEDURE  NUMBERED  PNUM  IN  THE 

*  SYMBOL  TABLE  SYMTAB.   AN  ERROR  IS  GIVEN  IF  THE 

*  REQUIRED  PROC  CANNOT  BE  FOUND.  IT  RETURNS  A  WORK 

*  NODE  FOR  THE  PROC  ONCE  IT  HAS  BEEN  FOUND.   THIS 


1391 

32  :n 

4 

13  92 

IZl'J 

1 

1393 

32:d 

H 

l39^ 

52:  J 

4 

1395 

32:j 

H 

1396 

33  :o 

3 

1397 

o3:d 

4 

1398 

33:j 

4 

1399 

33  :d 

4 

1400 

33  :d 

4 

moi 

33  :d 

4 

1402 

33:o 

4 

1^+03 

33:d 

4 

l<+0'+ 

34:d 

1 

1405 

34:d 

2 

1406 

34:o 

0 

1407 

34:i 

0 

1408 

34:2 

5 

1409 

34:3 

5 

1410 

34:3 

9 

1411 

34:3 

13 

1412 

34:3 

17 

1413 

34:^ 

26 

1414 

34:5 

35 

1415 

34:6 

35 

1416 

3416 

40 

1417 

34:7 

45 

1418 

34:8 

45 

1419 

34:9 

51 

1420 

34:0 

51 

1421 

34:0 

55 

1422 

34:9 

59 

1423 

34:8 

59 

1424 

34:7 

60 

1425 

34:6 

65 

1426 

34:6 

70 

1427 

34:6 

75 

1428 

34:6 

80 

1429 

34:6 

85 

1430 

34:6 

90 

1431 

34:6 

95 

* 

1 


NODE  IS  ALSO  ADDED  IMTO  THE  UPROCS  LIST.   ANY  PROCS 
ADDED  THIS  WAY  AR£  " INVISIBLE" »  DRAGGED  ALONG  BECAUSE 
OF  GLOBAL  REFS/DEFS. 


Function  findnadD(Symtab:  symp):  workp; 


*  PROCSRCH  RECURSIVLY  SEARCHES  THE  SYM  TREE  LOOKING 

*  FOR  THE  ACTUAL  SYMBOL  CONTAINING  PNUM,   THIS  DOES 

*  __  _ 


VIOST  OF  THE  WORK  OF  FINDNADD. 


PROCEDURE  PROCSRCHJSYM:  SYMP); 

var  wp:  workp; 

BEGIN 

IF  SYM  <>  NIL  THEN 
BEGIN 

PROCSRCH(SYM'*,LLINK)  ; 
PROCSRCH(SYM^.RLINK) ; 
PR0CSRCH(SYM'*.SLINK)5 

IF  SYM'*. ENTRY. LITYPE  IN  CSEPPROCt  SEPFUNCD  THEN 
IF  SYM'", ENTRY. SRCPROC  =  PNUM  THEN 
BEGIN 

WP  :=  UPROCS; 
WHILE  WP  <>  NIL  DO 
BEGIN 

IF  WP'^.REFSYM  =  SYM  THEN 
BEGIN 

FINDNADD  :=  ifdP; 
EXIT(FINDNADD) 
END; 
WP  :=  WP'^.NEXT 
END; 


NEW(WP); 
WP'^.REFSYM  :: 
Wp-'tREFSEG  :: 
WP'^.DEFSYM  ;: 
WP-^.DEFSEG  :: 
WP'^.NEEDSRCH 
WP'^.NEWPROC 


SYM; 

NIL; 

nil; 

nil; 

;=  TRUE; 
:  0: 


i03 


504 


l^iZ 

34:& 

U5 

1433 

34:& 

10 

1^+54 

34:6 

14 

1435 

3426 

18 

143o 

34:5 

22 

1437 

34:2 

22 

1438 

34:o 

22 

1439 

34:o 

36 

1440 

33:o 

0 

1441 

33:i 

0 

1442 

3311 

3 

1443 

33:i 

6 

1444 

33:i 

6 

1445 

33:o 

21 

1446 

33:o 

36 

1447 

32:o 

0 

1448 

32  :i 

0 

1449 

32:i 

5 

1450 

32:2 

10 

1451 

32:3 

10 

1452 

32:4 

16 

1453 

32:5 

16 

1454 

32:6 

23 

1455 

32:5 

25 

1456 

32:6 
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WP'^.iMEXT  :=  UPROCS; 
UPROCS  :=  WP; 
FINQNADD  :=  WP; 
EXIT(FINDNADD) 
END 


END 
END  C  PROCSRCH  1    ; 

BEGIN  C  FINDNADD  1 
FINDNADD  :=  NIL; 
PROCSRCHtSYMTAB) ; 
C  IF  WE  GET  HERE  THEN 
ERROR(»MISSING  PROCM 

END  C  FINDNADD  1    ', 


DIDNT  FIND  IT  1 


BEGIN  C  FINDNEWPROCS  D 

WP  :=  other;     c  a 

WHILE  WP  0  NIL  DO 
BEGIN 

IF  WP-^.DEFPROC  = 

BEGIN  C  FIND  PR 

IF  WP^.REFSYM 

PNUM  :=  WP*" 

ELSE  C  ASSUME 

PNUM  :=  WP** 

wpi  :=  pRocs; 

WHILE  WPl  0 
IF  WP-^.DEFS 
IF  WPl'^.D 
BEGIN  C 
WP'^.D 
WPl  : 
END 
ELSE 
WPl  :  = 
ELSE 

WPl  :=  WP 

IF  WP'^.DEFPRO 
WP'^.DEFPROC 
END; 
WP  :=  WP'.NEXT 


SSUME  ONLY  GLOBREF*  SEPPREFi  SEPFREF  IN  LIST  3 


NIL  THEN 

OC/FUNC  NEEDED  D 

'^. ENTRY. LITYPE  =  GLOBREF  THEN 

.DEFSYM^. ENTRY, HOMEPROC 

A  SEP  PROC/FUNC  3 
.  DEFSYM'". ENTRY.  SRCPROC; 

NIL  DO 

EG  =  WPl'^.DEFSEG  THEN 

EFSYM**. ENTRY, SRCPROC  =  PNUM  THEN 

ALREADY  GONNA  BE  LINKED  D 
EFPROC  :=  WPl; 
=  NIL 


WP1'",NEXT 

1'^.next; 

C  =  NIL  then  C  FORCIBLY  LINK  IT  1 
:=  FINDNADD  (WP'*,DEFSEG'',SYMTAB) 
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* 
* 

* 

* 
* 

* 
1 


resolve:  removes  work  items  from  inlist,  searches  symtabs 

FOR  its  CORHESPOrjDiNS  UEFINITION  SYMBOL  (ERROR  IF  NOT  FOUMD), 
AND  MOVES  THE  WORK  ITEM  INTO  THE  OUTPUT  LIST,   EACH  FLAVOR 
OF  WORK  ITEM  NEEDS  SOME  SPECIAL  HANDLING  TO  COLLECT  EXTRA 
INFO  RELATED  TO  SPECIFIC  THINGS.   IN  GENERAL,  DEFSYM  AND 
DEFSEG  ARE  FILLED  IN.   THE  INSERT  ALGORITHM  IS  SPECIAL  FOR 
PROCEDURE  TYPES  TO  MAKE  LIFE  EASIER  ON  REFSRCH. 


PROCEDURE  RESOLVE(VAR  INLIST,  OUTLIST:  WORKP); 
VAR  seg:  SEGRANGE; 

err:  boolean; 
wp:  workp; 


* 
* 
* 
* 
2 


SEPSRCH  SEQUENTIALLY  SEARCH  THE  SYMTABS  IN  THE  SEPLIST 
TO  RESOLVE  THE  REFSYM  OF  INLIST'^.   IT  BASICALLY  JUST 
CALLS  SYMSRCH  REPETIVELY  AND  FIXES  UP  DEFSYM  AND 
DEFSEG  FIELDS.   IF  THE  NAME  OF  THE  REFSYM  COULD 
NOT  BE  FOUND,  AN  ERROR  IS  GIVEN. 


PROCEDURE  SEPSRCH(0KTYPE:  LITYPES); 

VAR  syp:  symp; 
sp:  SEGp; 

BEGIN 

SP  :=  SEPLIST; 
WHILE  SP  <>  NIL  DO 
BEGIN 

SYP  :=  SYMSRCHdNLIST-, REFSYM-, ENTRY. NAME, 

OKTYPE,  SP-.SYMTAB); 
IF  SYP  0  NIL  THEN 
BEGIN 

INLIST**. DEFSYM  :=  SYP; 
INLIST". DEFSEG  :=  SP; 
SP  :=  NIL 
END 
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ELSE 

SP  :=  SP'^.NEXT 

END 
END  C  SEPSRCH  :  ! 


* 

* 

* 
* 
* 
1 


PROCINSERT  IS  CALLED  TO  INSERT  WORK  INTO  THE  PROCS 
LIST  USING  A  SPECIAL  SET  OF  SORT  KEYS  SO  THAT  COPYIN- 
PROCS  WILL  RUN  REASONABLY  FAST  AND  USE  THE  DISK 
EFFICIENTLY.   THE  PROCS  LIST  IS  SORTED  BY  SEGMENT, 
SRCBASE  KEYS,   THE  SEG  ORDERING  IS  DICTATED  BY  THE 
SEPLIST*  SO  USER  ASECTS  ETC  WILL  RETAIN  THEIR  ORIGINAL 
ORDERING. 


PROCEDURE  PR0CINSERT(W0RK:  WORKP); 
LABEL  1; 

VAR  crnt»  prev:  workp; 

SP:  SEGP5 
BEGIN 

PREV  :=  nil; 

SP  :=  SEPLISTJ 

WHILE  SP  0  OUTLIST'^.DEFSEG  00 
IF  SP  =  WORK'^.DEFSEG  THEN 
GOTO  1 

ELSE 

SP  :=  sp^.next; 

CRNT  :=  OUTLIST5 
REPEAT 

IF  CRNT'^.DEFSEG  =  WORK'^.DEFSEG  THEN 
REPEAT 

IF  WORK^.DEFSYM'". ENTRY. PLACE'^. SRCBASE  < 

CRNT^.DEFSYM^. ENTRY. PLACE'*. SRCBASE  THEN 

GOTO  1; 
PREV  :=  CRNT? 
CRNT  :=  CRNT'*. NEXT? 
IF  CRNT  =  NIL  THEN 
GOTO  1 
UNTIL  CRNT'^.DEFSEG  <>  WORK'^.DEpSEG 
ELSE 
BEGIN 
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PREV    :=    CRIMT; 

CRNT     :=    CR^IT-,^^IEXT; 

IF  CRNT  <>  NIL  THEN 

WHILE  SP  <>  CRNT'^.DEFSEG  DO 
IF  SP  =  rtlORK'^.DEFSEG  THEN 

GOTO  1 
ELSE 

SP  :=  SP^.NEXT 
END 
UNTIL  CRNT  =  NIL; 
1: 

IF  PREV  =  NIL  THEN 
BEGIN 

WORK'*. NEXT  :=  DUTLIST; 
OUTUST  :=  WORK 
END 
ELSE 
BEGIN 

WORK'*. NEXT  :=  PREV*. next; 
PREV*. NEXT  :=  WORK 
END 
END  C  PROCINSERT  U  ; 

BEGIN  C  RESOLVE  2 

WHILE  INLIST  <>  NIL  DO 
BEGIN 

WITH  iNLlST^t  REFSYM*. ENTRY  DO 
CASE  LITYPE  OF 

globref:    begin 

sepsrch(globdef); 
defproc  :=  nil 

END; 

constref:   if  hostsp  o  nil  then 
begin 
defsym  :=  symsrch(namef  constdef. 

HOSTSP'*. SYMTAB); 

defseg  :=  hostsp 

END; 

publkef:    if  hostsp  <>  nil  then 
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privkef: 


EXTPROCt 
SEPPKOC, 

seppref: 


EXTFUNC, 
SEPFUNC. 

sepfref: 


BEGIN 

defsym  :=  symsrch(namei  publdef, 

HOSTSP'^.SYMTAa)  ; 
DEFSEG  :=  HOSTSP 

END; 

BEGIN 

NEWOFFSET  :=  NEXTBASELC; 

NEXTBASELC  :=  NEXTBASELC+NWORDS ; 

IF  HOSTSP  <>  NIL  THEN 
DEFSYM  :=  REFSYM; 

DEFSEG  :=  HOSTSP 
END; 


BEGIN 

sepsrch(sepproc) ; 

if  litype  =  seppref  then 

DEFPROC  :=  NIL; 
ERR  :=  FALSE; 
IF  DEFSYM  <>  NIL  THEN 

IF  LITYPE  =  SEPPREF  THEN 

ERR  :=  DEFSYM'". ENTRY, NPARAMS  <>  NWORDS 
ELSE 

ERR  :=  DEFSYM'". ENTRY. NPARAMS  <>  NPARAHS; 
IF  ERR  THEN 
BEGIN 

WRITECPROC  •»  NAME); 
ERRORC  PARAM  MISMATCH*) 
END 
END? 


BEGIN 

SEPSRCH(SEPFUNC); 

IF  LITYPE  =  SEPFREF  THEN 

DEFPROC  :=  NIL; 
ERR  :=  FALSE; 
IF  DEFSYM  <>  NIL  THEN 

IF  LITYPE  =  SEPFREF  THEN 

ERR  :=  DEFSYM'". ENTRY. NPARAMS  <>  NWORDS 
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Else 

ERR  :=  DEFSYii-r. ENTRY. NPARAMS  <>  NPARAMS; 
IF  ERR  THEN 
6EGIN 

WRITECFUNC  ♦»  NAME); 
ERRORC  PARAM  MISMATCH') 
END 
ENQ; 

U;miTHEF:     if  UNITSRCH{H0STFILE»  NAME,  SEG)  =  HOSTFILE  THEN 
BEGIN  C  WILL  BE  FOUND  IN  HOST  3 
DEFSYM  :=  REFSYM; 
DEFSEGNUM  :=  SEG 

END 

else  c  "impossible"  d 
errorcunit  errm 
end  c  cases  2   \ 

wp  :=  inlist! 

INLIST  :=  WP'^.NEXT; 
IF  WP*^, DEFSYM  =  NIL  THEN 
WITH  WP*". REFSYM-^, ENTRY  DO 
BEGIN 

CASE  LITYPE  OF 

GLOBREF:   WRITEt 'GLOBAL  '); 
PUBLREF:   WRITECPUBLIC  '); 

constref:  write( 'CONST  ♦); 

SEPPREF, 

extproc:  writecproc  •)•♦ 

SEPFREF, 

EXTFUNC:   WRITECFUNC  •) 
END  C  CASES  3  ; 
WRITE(NAME); 
ERRORC  UNDEFINED') 
END 
ELSE 

IF   (WP^tDEFSYW*. ENTRY. LITYPE  IN  CSEPPROCt  SEPFUNC3) 
AND  (OUTLIST  <>  NIL)  THEN 

PR0CINSERT{WP) 
ELSE 
BEGIN 
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END 

C 
* 

* 

* 

* 
♦ 

* 
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WP'.NEXT  :=  OUTLIST; 
OUTLIST  :=  viP 

END  C  WHILE  1 
C  RESOLVE  J  ; 


REFSRCH  SLOWLY  GOES  THROUGH  ALL  REFERENCE  LISTS  IN  SYMBOLS 
WHICH  ARE  IN  THE  OkSET  TO  SEE  IF  ANY  "OCCUR"  WITHIN  THE 
PROCEDURES/FUNCTIONS  SELECTED  TO  BE  LINKED,  THAT  IS  CONTAINED 
IN  PROCS  LIST,   IT  IS  ASSUMED  THAT  PROCS  IS  SORTED  BY  DEFSEG 
SO  ONLY  THE  PROCS  BETWEEN  IPL  AND  LPL  ARE  SEARCHED, 
ANY  SYMBOLS  WHICH  HAVE  ANY  REFS  IN  SELECTED  PROCS  ARE  GIVEN 
WORK  NODES  AND  ARE  PLACED  IN  THE  UOTHER  LIST  IN  NO  CERTAIN 
ORDER  SO  RESOLVE  CAN  BE  CALLED  RIGHT  AWAY, 


PROCEDURE  refsRch(Okset:  liset;  sp:  segp); 
VAR  LPL,  ipl:  workp; 

DIFFSEG:  BOOLEAN! 


c 

* 

* 
2 


CHECKREFS  RECURSIVLY  searches  SYM  TREE  TO  KIND  NAMES 
IN  THE  OKSET.   WHEN  ONE  IS  FOUND,  EACH  OF  ITS  REF  POINTERS 
ARE  CHECKED  TO  SEE  IF  THEY  FALL  IN  ONE  OF  THE  PROCS 
TO-BE-LINKED  (BETWEEN  IPL  S  LPL).   IF  SC,  A  NEW  WORK  ITEM 
IS  GENERATED  AND  IT'S  PUT  ON  THE  UOTHER  LIST, 


PROCEDURE  CHECKREFS(SYM:  SYMP); 
LABEL  1,  2; 
VAR  PL,  WP:  WORKP; 

I,  N,  REF:  integer; 
Rp:  KEFp; 

BEGIN 

IF  SYM  0  NIL  THEM 
SEGIN 

CHECKREFSCSYM'^.LLINK)  ; 
CHECKREFS(SYM'*.RLINK)  \ 
CHECKREFS(SYM'*, SLINK)  I 
WITH  SYM'^. ENTRY  DO 
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IF  LITYPE  I'M  OKSET  THEN 
BEGIM 

N  :=  NR^FS; 
Rp    :=    REFLIST; 
i^lHILE  RD  <>  NIL  DO 
BEGIN 

IF  N  >  a  THEN 
3EGIN 

I  :=  7; 

N  :=  N-8 

END 
ELSE 

I  :=  N-i; 

REPEAT  C  FOR  EACH  REF  D 
REF  :=  RP'*,REFSCI3; 

PL  :=  ipl; 

REPEAT  C  SEARCH  PROC  LIST  1 
IF  PL'^.NEEDSRCH  THEN 

WITH  PL'*. DEFSYM'^. ENTRY. PLACE''  DO 
IF  REF  <  SRCBASE  THEN 

GOTO  2  C  TERMINATE  PROC  SEARCH  2 
ELSE 

IF  REF  <  SRCBASE+LENGTH  THEN 
BEGIN  C  OCCURS  IN  PROC  2 
NEW<WP)« 

WP^.REFSYM  :=  SYM; 
WP^.REFSEG  ;=  SPJ 
WP-^tDEFSYM  :=  NIL; 

wp-^.DEFSEG  :=  nil; 
wp'^.NExT  :=  uother; 
UOTHER  ;=  wp; 
GOTO  1 
END; 
PL  :=  PL". NEXT 
UNTIL  PL  =  LPL; 
2: 

I  :=  i-i 

UNTIL  I  <  0; 
RP  :=  RP'^.NEXT 
END  C  WHILE  J 
END 
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1: 


END  C  CHECKREFS  J  ; 

5EGIN  C  KEFSKCH  D 
IPL  :=  NIL; 

LPL  :=  PRocs; 

ifllHILE    LPL    <>    NIL    DO 

IF  (LPL'^.DEFSEG  =  SP) 
AND  LPL^.Nt-EDSRCH  THEN 
BEGIN 

IPL  :=  lpl; 

LPL  :=  NIL 

END 
ELSE 

LPL  :=  LPL'*. next; 

IF  IPL  0  NIL  THEN 
BEGIN 

LPL  :=  IPL; 

REPEAT 

DIFFSE5  :=  LPL'^.DEFSEG  <>  IPL^.DEFSEG; 
IF  NOT  DIFFSEG  THEN 
LPL  :=  LPL'^.NEXT 
UNTIL  DIFFSEG  OR  (LPL  =  NIL)? 
CHECKREFSiSP'^.SYMTAB)  ; 
REPEAT 

IPL-^.NEEDSRCH  :=  FALSE; 
IPL  :=  IPL'*. NEXT 
UNTIL  IPL  =  LPL 
END 
EISjD  C  REFSRCH  3  ; 


Z 

* 
* 

* 


FINDLOCALS  RECURSIVLY  SEARCHES  THE  MAIN  SEGS  SYMTAB  TO 
PLACE  ANY  UNRESOLVED  THINGS  LIKE  PUBLIC  REFS  IN  UNIT 
SEGS  INTO  THE  ULOCAL  LIST  SO  THEY  CAN  BE  FIXED  UP  IN 
FIXUPREFS  IN  ADDITION  TO  THE  SEP  PROC  THINGS. 


PROCEDURE  FInDLOCALSCSYM;  SYMP) 5 

VAR  wp:  workp; 
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BEGIN 

IF  SYM  0  NIL  THEN 
BEGIN 

FIfNlOLOCALS(SYM''.LLINK)  ; 
FINDLOCALS(SYM'^,RLINK)  ; 
FINDL3cALS(3YM^, SLINK) ; 
IF  SYr^-. ENTRY. LITYPE  IN 
aEGiN 

NEW(WP) 5 

WP'^.KEFSYiVl  :=  SYM; 
WP'^.REFSEG  :=  NIL; 
inlP'^.OEFSYM  :=  NIL; 
WP-^.DEFSEG  :=  NIL; 
mlP'^.NEXT  :=  ulocal; 
ULOCAL  :=  WP 
END 
END 
END  C  FINDLOCALS  2    ; 


BEGIN  C  BUILDWORKLISTS  1 
PROCS  :=  NIL; 

LOCAL  :=  nil; 
OTHER  :=  nil; 

UPROCS  :=  NIL; 
ULOCAL  :=  NIL; 
UOTHER  :=  NIL; 
WITH  SEGINF0CS3'"  DO 

IF  SEGKIND  <>  LINKED  THEN 
3EGIN 

SEPHOST  :=  SEGKIND  =  SEPRTSEG; 
IF  SEPHOST  THEN 
BEGIN 


CUNITREFt  PUBLREF,  PRIVREF]  THEN 


NEXT  := 
SEPLIST 
UPROCS 
END 
ELSE 

UPROCS  := 
WHILE  UPROCS 
BEGIN 

RESOLVE(UPROCS. 


SEPLIST; 
:=  SEGINFOCSJ; 
:=  FINDPROCS(CSEPpROC, 


SEPFUNCDt  SYMTAB) 


FINDPR0CS(CEXTPR0C» 
0  NIL  00 


PROCS) 


EXTFUNC3,  SYMTAB) 
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5P  :=  SEPLIST; 
WHILE  SP  <>  NIL  DO 
BEGIN 

rehsrch(cgl03ref.  seppref,  sepfrefdt  sp)5 
sp  :=  sp'^.next 

emd; 

RESaL\/t{UOTHER,    OTHER); 
FIMDNEWPROCS 

end; 

IF  NOT  SEPHOST  THEN 
BEGIN 

FINDL0CALS(SYMTA3); 

resolve(ulocal»  local) 

end; 
WP  :=  PROCS; 

WHILE  WP  <>    NIL  DO 
BEGIN 

WP'^.NEEDSRCH  :=  TRUE; 
WP  :=  WP'^.NEXT 

end; 
sp  :=  seplist; 
while  sp  <>  nil  do 

BEGIN 

REFSRCH(CPUBLREFt  PRIVREF,  C0NSTREF3,  SP); 
SP  :=  SP'^.NEXT 

END; 
RESOLVE(UOTHER»  OTHER) 
END 
END  C  BUILDWORKLISTS  1    ; 

LINK3A  2 
LINK3B  2 

(*♦**♦*************♦***************♦******♦**♦********♦♦♦****♦*****) 

(*  *) 

(*  COPYRIGHT  (C)  1978  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA.  *) 

(*  PERMISSION  TO  COPY  OR  DISTRIBUTE  THIS  SOFTWARE  OR  DOCUMEN-  ♦) 

(*  TATION  IN  HARD  OR  SOFT  COPY  GRANTED  ONLY  BY  WRITTEN  LICENSE  ♦) 

(♦  OBTAINED  FROM  THE  INSTITUTE  FOR  INFORMATION  SYSTEMS,  ♦) 

(*  *) 


1882 

29:o 

4-0 

ld33 

29  :o 

'to 

C 

18614 

29:o 

46 

* 

1665 

29:  c 

4o 

*• 

laafc 

29:u 

46 

* 

1667 

29:0 

46 

* 

1888 

29:o 

46 

* 

1869 

29:0 

46 

* 

1B90 

29:o 

46 

* 

1691 

29:o 

46 

* 

1892 

29:0 

46 

* 

1893 

29:0 

46 

* 

lag^ 

29:o 

16 

2 

1895 

29:0 

46 

1896 

fllD 

1 

PI 

1897 

4i:d 

1 

1898 

'+i:d 

1 

1899 

f+iro 

1 

1900 

41:0 

6 

1901 

m:D 

7 

1902 

fi:D 

8 

1903 

41:0 

9 

1904 

'HID 

9 

1905 

i+lID 

9 

1906 

fllD 

9 

1907 

m:D 

9 

1908 

4i:d 

9 

1909 

'fllD 

9 

1910 

ii:d 

9 

1911 

'fllD 

9 

1912 

4i:o 

9 

1913 

h2:d 

1 

19m 

it2:D 

1 

1915 

42:d 

1 

1916 

^+2:0 

6 

1917 

^+2:0 

0 

1918 

't2:i 

0 

1919 

12:1 

13 

1920 

'+2:2 

27 

1921 

'+2:3 

27 

1922 

'+2:3 

43 

READSRCSEG  DETtKwilNES  THE  FINAL  SEGMENT  SIZE  AFTER  ADDING 

ij  the  exter,-jal  procs/funcs,  allocates  enough  area  for  the 
Entire  output  code  seg,  reads  in  the  original  code  (or  uses 
Identity  segivient  for  sephost  special  case),  and  splits  the 
segdict  off  from  the  code,  for  all  progs  to-be-linked,  a  new 
destbase  position  is  assigned  in  seg  and  the  new  proc  num  is 
set  up  in  pdict.  the  segment  number  field  of  the  pdict  is 
also  updated  to  the  value  of  s.  all  is  ready  to  copy  in  the 
sep  procs/funcs.  the  values  for  segbase  and  segleng  are  set 

HERE  TOO. 


PROCEDURE  READSRCSEG; 
VAR  ORGLENG,  ADDR, 

ADDLENG,  ADDPROCS, 
NEXTSPOT:  INTEGER; 

last:  0..maxproc; 
wp:  workp; 

LHEAP:  '^INTEGER; 


♦ 

* 
* 

« 

1 


READNSPLIT  ARRANGES  FOR  THE  SOURCE  SEG  TO  BE  PLACED  IN 
ROOM  ALLOCATED  FOR  SEGBASE,   THIS  MAY  INVOLVE  DISK  READ 
OR  PERHAPS  ONLY  CREATING  AN  EMPTY  SEGMENT.   IN  ANY  CASE 
SEGBASE  POINTS  AT  LOWEST  ADDR,  AND  NEXTSPOT  IS  POINTED 
AT  THE  NEXT  PLACE  CODE  CAN  BE  COPIED  INTO,   THIS  IS  USED 
FOR  DESTBASE  ASSIGNMENT  IN  READSRCSEG, 


PROCEDURE  READNSPLIT; 

VAR  NBLOCKSt  N,  PDLENG, 

PDDELTA,  NPROCS:  INTEGER; 
CPO,  CPi:  CODEP; 
BEGIN 

NBLOCKS  :=  (SEGLENG+511)  DIV  512; 
IF  MEMAVAlL-'+OO  <  NBL0CKS*256  THEN 
BEGIN 

ERROR( 'NO  MEM  ROOM' ) ; 
EXITtLINKER) 


15 


OxCt 


1925 

42:2 

47 

1924 

42:i 

47 

1925 

42:i 

DO 

1926 

42:i 

bO 

1927 

42:2 

50 

1928 

42:2 

57 

1929 

42:i 

58 

1930 

42:i 

G7 

1931 

"+212 

72 

1932 

42:3 

72 

1933 

42:3 

83 

193<+ 

42:2 

a3 

1935 

42:i 

87 

1936 

42:2 

89 

1937 

'+2:3 

89 

1938 

*t2:3 

02 

1939 

42:3 

19 

1940 

42:4 

33 

igi+i 

42:5 

33 

1942 

12:5 

50 

1943 

42:4 

54 

1944 

42:3 

54 

1945 

42:3 

63 

1946 

42:3 

77 

1947 

42:3 

84 

1948 

42:3 

92 

1949 

42:3 

07 

1950 

42:3 

22 

1951 

42:4 

27 

1952 

42:5 

27 

1953 

42:5 

30 

1954 

42:6 

35 

1955 

42:7 

55 

1956 

42:7 

49 

1957 

42:7 

59 

1958 

42:6 

60 

1959 

42:5 

66 

1960 

42:5 

73 

1961 

42:4 

79 

1962 

42:2 

79 

1963 

42:0 

79 

SEG    D 

SEGLENG-2) ; 


end: 
N    :=    rJ3L0CKSi 
REPEAT 

C    ALLOC    HEAP    SPACE    3 

f-JE^CCPi)  ; 

f\i  :=  N-i 

UNTIL  N  <=  0; 
IF  SEPHOST  THEN 

BEGIN  C  SET  UP  IDENTITY 
STOREWORU(0,  SEG3ASE, 
NEXTSPOT  :=  0 
END 
ELSE 

BEGIN  C  READ  FROM  DISK  3 

NBLOCKS  :=  (ORGLENG+511)  DIV  512? 

IF  BL0CKREAD<SEGINF0CS3'*.SRCFILE'^.C0DE'^,  SEGBASE", 
NBLOCKS,  ADDR)  <>  NBLOCKS  THEN 
BEGIN 

ERROR( 'SEG  READ  ERR') ; 
EXIT(LINKER) 
END; 
PDDELTA  :=  SEGLENG-ORGLENG; 
NPROCS  :=  FETCH8YTE(SEGBASE,  ORGLENG-1); 
PDLENG  :=  NPR0CS*2+2; 
NEXTSPOT  :=  ORGLENG-PQLENG; 

CPO  :=  GETCODEP(ORD(SEGBASE)+ORGLENG-PDLENG) ; 
CPl  :=  GETCODEP(ORD(SEGBASE)+SEGLENG-PDLENG) 5 
IF  CPO  <>  CPl  THEN 

BEGIN  t  MOVE  PROC  DICT  J 
N  :=  PDLENG; 
WHILE  N  >  2  DO 
BEGIN 

STOREWORDCPDDELTA+FETCHWORDCSEGBASE,  ORGLENG-N) » 

SEGBASEt  ORGLENG-N); 
N  :=  N-2 

end; 

MOVEKIGHT(CP0'*,  CPl**,  PDLENG)? 
FILLCHAR(CP0^.  PDDELTA,  0) 
END 
END 
END  C  READNSPLIT  3  ; 
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,  SRCFILE'^.SEGTBL.DISKINFOCSRCSEGD  DO 


:=  CODELENG; 
COUEADDR 


BEGIM    C    READSRCSE>i     ■ 
IF    SEPHOST    THEr>j 

DRGLETviG    :=    2 
ELSE 

WITH    SEGINFOCSU' 
BEGIN 

ORGLENG 
ADDR     := 
END; 

addleng  :=  o; 
addprocs  :=  0; 
wp  :=  pRocs; 

WHILE  I/\1P  <>  NIL  DO 

BEGIN  C  ADD  UP  FINAL  SEG  SIZE  1 

ADDLENG  :=  AUDLENG  +  WP^, DEFSYM'". ENTRY. PLACE^, LENGTH  ; 
IF  WP'^.NEWPROC  =  0  THEN 

ADDPROCS  :=  ADDPROCS+l; 
WP  :=  WP'^.NEXT 

END; 
mark(lheap); 

seg3ase  :=  getcodep{ord(lheap) ) ; 
segleng  :=  orgleng+addleng+2*addprocs; 

IF  segleng  <=  0  THEN 
BEGIN 

ERR0R{»SIZE  OFLOWn  ; 
EXIT(LINKER) 

END; 

readnsplit; 

last  :=  fetchbyt£(segbasef  segleng-1); 

WP  :=  procs; 

while  WP  <>  nil  uo 

BEGIN  Z    ASSIGN  PLACES  IN  CODE  SEG  1 
WITH  WP'^.DEFSYM''. ENTRY, PLACE"  DO 

BEGIN 

destbase  :=  nextspot; 
nextspot  :=  nextspot-j-length 
end; 

IF  WP'^.NEWPROC  =  0  THEN 

BEGIN  C  ASSIGN  NEW  PROC  U    1 
LAST  :=  LAST+i; 
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IF    LAST    >    MAXPROC    THEN 
BEGIN 

ERKOK('pHOC    r\l'JM    OFLOI«M; 
LAST    :=    1 

END; 

wp^.newproc  :=  last 
end; 
wp  :=  wp^.next 
end; 
storebyte(last,  segbase,  se6leng-1); 
storebyte(si  segbasei  segleng-2) 
end  c  reaosrcseg  1  \ 


coprinprocs  goes  through  procs  list  and  copies  procedure 
Bodies  from  the  sep  segs  into  the  dest  code  segment  into 
locations  set  up  in  reaosrcseg,  if  all  goes  righti  we  should 
fill  dest  seg  to  the  exact  byte.  the  proc  dict  is 
updated  to  show  procedures'  position, 


PROCEDURE  COPYINPROCS; 
VAr  CPO.  CPlf  PDP» 

JTAB.  sepbase:  codep; 
wp:  workp; 
cursp:  segp; 

LHEAP:  '^INTEGER; 

L 

♦  READSEPSEG  heads  the  SEP  SEG  IN  SP  ONTO  THE  HEAP  AS 

♦  DONE  IN  PHASE  2.   WE  SET  UP  SEPBASE  AND  CURSP  FOR 

♦  COPYINPROCS, 
1 

PROCEDURE  REaDSEPSEG(SP:  SEGP); 

VAR  Nt  NBLOCKS:  INTEGER; 
3EGIN 

RELEASE(LHEAP) ; 

N  :=  SP'^.SRCFILE'".SEGTBL.DISKInF0CSP'*.SRCSEG3,C0DELENG; 

NBLOCKS  :=  (N+511)  DIV  512; 

IF    wiEMAVAlL-'tOO    <    NBL0CKS*256    THEN 
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43:0 

0 

2066 

43:1 

0 

2067 

43:1 

3 

2068 

43;i 

6 

2069 

43:1 

10 

2070 

43:1 

15 

2071 

43:2 

20 

2072 

43:3 

29 

2073 

43:4 

29 

207*+ 

43:5 

35 

2075 

43:4 

39 

2076 

43:5 

42 

2077 

43:6 

42 

2078 

43:6 

63 

2079 

43:7 

69 

2080 

43:6 

84 

2081 

43:7 

86 

2082 

43:6 

01 

2083 

43:5 

16 

2084 

43:4 

16 

2085 

43:4 

27 

2086 

43:4 

40 

3ZGIU 

£R^OR( •OUT    OF    M^M* ) ; 
EXIKLINKEIR) 

lNd; 

iM    :=    NBLOCKS; 
REPEAT 

NEW(SEPBASt) ; 

H  :=  N-i 

UNTIL    ^J    <=    0; 

SEPBASE    :=    GETCODEP(ORD(LHEAP)); 

IF    BLOCKREaDCSP'^.SRCFILE'^.CODE'*,    SEPBASE^t    NBLOCKSf 

SP-.SRCFILE-.SEGT3L.0ISKINF0CSP-,SRCSEGD.C0DEADDR)    <>    NBLOCKS    THE 
SEG I IM 

ERROR(»SLP    SEG    READ    ERRM; 

EXIT(LINKER) 

end; 
CURSP  :=  SP 
END  C  READSEPSEG  D  5 

begin  c  copyinprocs  ] 
sepbase  :=  nil; 
cursp  :=  nil; 
mark(lheap) ; 
WP  :=  pRocs; 

WHILE  WP  0  NIL  DO 

WITH  WP-**  DEFSYM-. ENTRY  00 
BEGIN  Z    COPY  IN  EACH  PROC  1 
IF  CURSP  0  DEFSEG  THEN 

REAOSEPSEG(DEFSEG) ; 
IF  TALKATIVE  THEN 
BEGIN 

WRITEC    COPYING  •); 

IF  LITYPE  =  SEPPROC  THEN 

WRITE(»PR0C  •) 
ELSE 

WRITE(»FUNC  •); 
WRITELN(NAME) 
END; 

CPO  :=  GETCODEP{ORD(SEPBASE)+PLACE'^.SRCBASE); 
CPl  :=  GETCODEP(ORD(SEGBASE)+PLACE'*.DESTBASE); 
MOVELEFT(CP0'^,  CPl'*,  PLACE-*. LENGTH)  ; 


519 


2037 

2  083 

2039 

2090 

2091 

2092 

2093 

209^ 

2095 

2096 

2097 

2098 

2099 

2100 

2101 

2102 

2103 

210H 

2105 

2106 

2107 

2108 

2109 

2110 

2111 

2112 

2113 

211*+ 

2115 

2116 

2117 

2118 

2119 

2120 

2121 

2122 

2123 

212^+ 

2125 

2126 

2127 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


"+3; 
'+3; 
43; 
43; 
43; 
43: 
43; 


43:i 
43:o 
43:o 
43:o 
43:o 
43:o 
43:o 
43:o 
43:o 
43  :o 
43:o 
45:d 

45ID 

45  :d 
45:d 
45:o 
45:o 
45:i 
45:2 
45:3 
45:3 
45:4 
45:4 
45:4 
45:4 
45:4 
45:4 
45:5 
45:4 
45:4 

45:6 

45:7 

45:6 

45:7 


49 
63 
78 
84 
04 

11 
11 

17 

19 

38 

38 

38 

38 

38 

38 

38 

38 

38 

1 

3 

7 

9 

10 

0 

0 

5 

14 

14 

14 

18 

18 

25 

31 

39 

43 

54 

b4 

54 

60 

60 

66 


JTAB  :=  &ETC0DEP(0RD(SEG8ASE)+PLACE''.DESTBASE  +  PLACE'*.LENGTH-2) 
IF  F£TCHBYTE(JTAB,  0)  <>  0  THEN 

ST0RE3yTL(NEWPK0C,  JTABi  0); 
PDF  :=  GETC0DEP(0RD(SEGBASE)+SEGLENG-2*NEWPR0C-2) ; 
STOREWORD(ORD(PDP)-ORD(JTAB) ,  PDP,  0); 
WP  :=  NEXT 

eno; 

RElEASE(LHEAP) 
END  C  COPYINPROCS  ^    i 


3^,1 


c 

* 

* 

* 


FIXUPREFS  IS  CALLED  TO  SEARCH  THROUGH  REFlISTS  AND  FIX 

Operand  fields  of  p-code  and  native  code  to  refer  to  the 
resolved  values.  if  fixallrefs  is  truei  then  all  pointers 
iim  the  ref  lists  are  usedt  otherwise  the  reference  pointers 
are  checked  to  see  if  they  occur  in  the  procs  to-be-linked. 


PROCEDURE  fixuprefs(work:  workp; 

VAR  N,  I,  REF,  VAL:  INTEGER; 

wp,  wpi:  woRKP; 
rp:  refp; 

SKIPIT:  BOOLEAN; 
BEGIN 

WHILE  WORK  0  NIL  DO 

WITH  WORK'^f  REFSYW*. ENTRY  00 

BEGIN  C  FOR  EACH  WORK  ITEM 

C  FIGURE  RESOLVE  VAL 

CASE  litype:  of 

SEPPREFt 
SEPFREF:   VAL  ! 

unitref:  VAL  : 

CONSTREF:  VAL  I 
GLOBREF:   VAL  ! 


FIXALLREFS:  BOOLEAN); 


defproc.newproc; 
defsegnum; 

DEFSYM'*. ENTRY.  CONSTVAL; 
OEFS YM**. ENTRY.  ICOFFSET  + 
OEFPROC'^.DEFSYM'^. ENTRY. PLACE'*,  DESTBASE; 


PUBLREF* 

privref: 


BEGIN 

IF  LITYPE  =  PRIVREF  THEN 

VAL  :=  NEWOFFSET 
ELSE 

VAL  :=  DEFSYW*. ENTRY, BASEOFFSET; 


2123 

15:6 

72 

2129 

15:7 

78 

2130 

15:6 

83 

21il 

15:7 

89 

2132 

'+5:8 

91 

2133 

15:5 

07 

2131 

15:1 

09 

2135 

15:1 

16 

2136 

1+5:1 

50 

2137 

ib:i 

55 

2138 

'+5:5 

60 

2139 

15:6 

60 

2140 

'+5:7 

65 

21'^1 

15:8 

65 

2112 

i+srs 

68 

2113 

15:7 

69 

2111 

15:6 

73 

2115 

'+5:7 

75 

2116 

15:6 

80 

2117 

15:7 

80 

2118 

f5:7 

92 

2119 

'+5:7 

96 

2150 

^+5:8 

99 

2151 

^+5:9 

99 

2152 

f5:9 

02 

2153 

45:9 

07 

2151 

45:0 

12 

2155 

*+5:i 

19 

2156 

'+5:2 

19 

2157 

'+5:2 

22 

2158 

15:1 

22 

2159 

^+5:0 

25 

2160 

^+5:1 

27 

2161 

1+5:9 

33 

2162 

45:0 

40 

2163 

1+5:1 

17 

2161 

1+5:2 

53 

2165 

1+5:3 

59 

2166 

1+5:1 

68 

2167 

15:5 

68 

2168 

1+5:5 

77 

END 
LNDi 

I'j  :=  NREFs; 
RP  :=  Rlflist; 

WHILE  RP  <>  NIL 
BEGIN 

IF  N  >  8 
BEGIN 

I  :  = 

N  :  = 
End 

ELSE 

I 

REPEAT 
REF 


IF  FORMAT  =  WORD  THEN 

VAL  :=  (VAL-1)*2+MSDELTA 

ELSE  C  ASSUME  3IG  D 
IF  VAL  <  0  THEN 

ERROR(»ADDR  OFLOW) 


DO 


THEN 

7; 

N-8 


:=  N-i; 


DO 

=  REFSEG 

MATCHING 


THEN 
SEG  3 


=  RP^.REFSCID; 
SKIPIT  :=  NOT  FIXALLREFS; 
IF  SKIPIT  THEN 

BEGIN  C  SEE  IF  PERTINENT 

wp  :=  nil; 
wPi  :=  PRocs; 

WHILE  WPI  0  NIL 

IF  WPl^.DEFSEG 

BEGIN  C  FIND 

WP  :=  wpi; 

WPl  :=  NIL 
END 
ELSE 

WPl  :=  WPl'^.NEXTJ 
WHILE  (WP  <>  NIL)  AND  SKIPIT  DO 
IF  WP-.DEFSEG  =  REFSEG  THEN 
WITH  WP'^.DEFSYM'^. ENTRY. PLACE'* 
IF  REF  >=  SRCBASE  THEN 

IF  REF  <  SRCBASE+LENGTH  THEN 
BEGIN 

REF  :=  REF-SRCBASE+OESTBASE; 
SKIPIT  :=  FALSE 


DO 


321 


3P^ 


21b9 

15:4 

77 

END 

2170 

45:3 

dO 

ELSE 

2171 

45:4 

32 

WP  :=  WP'^.NEXT 

2172 

45:2 

83 

ELSE 

2173 

45:3 

88 

WP  :=  NIL 

2171+ 

4b:o 

88 

ELSE 

2175 

45:1 

93 

WP 

:=  NIL 

2176 

45:a 

93 

ENU; 

2177 

45:7 

98 

IF  NOT  SKIPIT  THEN 

2178 

45:a 

02 

CASE  FORMAT  OF  C  FIX  UP  THIS  REF  1 

2179 

45:8 

06 

word: 

STOREWORD(\/AL+FETCHWORD{SEGBASE,  REF)  ♦ 

2180 

45:9 

16 

SEGBASE,  REF); 

2181 

45:8 

24 

byte: 

STOREBYTECVALt  SEGBASE*  REF); 

2182 

45:8 

33 

big: 

STOREBIG(VAL»  SEGBASE,  REF) 

2183 

45:8 

38 

end; 

218*+ 

45:7 

56 

I  :=  i-i 

2185 

4516 

57 

until  I  <  0; 

2186 

45:6 

66 

RP  :=  RP'^.NEXT 

2187 

45:5 

67 

end; 

2188 

45;4 

72 

WORK  :=  NEXT 

2189 

45:3 

72 

end 

2190 

45:0 

76 

END  C  FIXUPREFS  3    5 

2191 

45:0 

04 

2192 

45:0 

04 

C 

2193 

45:0 

04 

* 

WRITETOCODE  TAKES  THE 

FINALIZED  DESTSEG  AND  PUTS  IT  IN 

219^ 

45:0 

04 

« 

The  OUTPUT  CODE  FILE, 

THIS  ALSO  INVOLVES  SETTING  UP  VALUES 

2195 

45:0 

04 

* 

IM  THE  FINAL  SEGTABLE 

FOR  WRITEOUT  JUST  BEFORE  LOCKING  IT, 

2196 

45:0 

04 

1 

2197 

45:0 

04 

2198 

46:d 

1 

PROCEDURE  WRITETOCODE; 

2199 

46:d 

1 

var  nblocks:  integer; 

2200 

46:d 

2 

jtab:  codep; 

2201 

46:o 

0 

BEGIN 

2202 

46:i 

0 

IF  hOSTSP  =  SE6INF0CS3 

THEN 

2203 

46:2 

15 

BEGIN  C  FIX  UP  BASELC  1 

2201 

46:3 

15 

JTAB  :=  GETC0DEP(0RD(SEGBASE)+SEGLENG-4); 

2205 

46:3 

30 

JTAB  :=  GETCODEP(ORD(JTAa)-FETCHWORD(JTAB.  0)); 

2206 

46:3 

44 

STOREW0RD(NEXTBASELC*2-6.  JTAB,  -8) 

2207 

46:2 

52 

END; 

2208 

46:i 

54 

WITH  SEGINFOCSl'"*  SEGTBL  DO 

2209 

46:2 

67 

BEGIN 

2210 

2211 

2212 

2213 

2214 

2215 

2216 

2217 

2218 

2219 

2220 

2221 

2222 

2223 

222<+ 

2225 

2226 

2227 

2228 

2229 

2230 

2231 

2232 

2233 

223t 

2235 

2236 

2237 

2238 

2239 

22«+0 

2211 

2242 

2243 

2244 

2245 

2246 

2247 

2248 

2249 

2250 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


4&:3 
4&:3 
4&:4 

46;  5 
46:5 

4&:i+ 

46:3 
46:3 
46:3 
46:3 
46:3 
46:2 

46:o 
46:o 
46:o 
46:o 
46:o 
46;o 
46:o 
46:o 

4610 

46:o 
46:o 

46:o 

47  :d 

47:d 
4710 

47:d 
47:d 
47:d 
47:d 

48:0 

48:d 
48:d 

48  :o 
48:i 

48:2 

48:i 
48:i 

48:2 

48:i 


67 
30 
00 
00 
19 
23 
23 
38 
55 
79 
93 
96 
01 
14 
14 
14 
14 
14 
14 
14 
14 
14 
14 
14 
1 
1 
1 
1 
1 
1 
1 
1 
1 
2 
0 
0 

13 

81 

86 

91 

21 


END 


iMBLOCKS  :=  (SEbLEfje  +  bll)  DI\J    5l2; 

IF  BL0CKWKITE(C0DE,  SEGBASE-,  ^BLOCKS,  NEXTBLK)  <>  NBLOCKS  THEN 
dEGI'J 

ERROR(  'CODE:  WRITE  ERR')  ; 
EXIT(LINKER) 

end; 

DISKINFOCSD.CODEADDR  :=  NEXTBLK; 
DI3KINF0CSD.C0DELENG  :=  SEGLENG; 
SEGNAMECSa  :=  SRCFlLE-.SEGTBL.SEGNAMECSRCSEGa; 

SEGKiNocs:  :=  linked; 

NEXTBLK  :=  NEXTBLK+NBLOCKS 

eno 

c  writetocooe  ^   ; 


* 

* 
* 

* 
1 


LINKSEGMENT  IS  CALLED  FOR  EACH  SEGMENT  TO  BE  PLACED  INTO 
THE  FINAL  CODE  FILE.   THE  GLOBAL  VAR  S  HAS  THE  SEGINFO  INDEX 
PERTAINING  TO  THE  SEGMENT,  AND  ALL  THE  OTHER  PROCEDURES  OF 

THE  SAlTER'sF?'srS.p'jrv'^''-   '"^^  ^'^^^  FAClLnA^Er^INKING 
THE  MASTER  SEg  SEPARATLY  FROM  THE  OTHER  SEGS  TO  ENSURE  THAT 

THE  DATASZ  OF  THE  OUTER  BLOCK  CORRECTLY  REFLECTS  THE  NUMRFR 
OF  PRIVREF  WORDS  ALLOCATED  BY  RESOLVE.   ''^'^'""^^  ^"^  ^^"^^^ 


PROCEDURE  LINKSEGMENT; 


*  WRITEMAP  IS  CALLED  FOR  EACH  SEG  TO  WRITE  SOME 

♦  INFO  INTO  MAP  FILE. 

PROCEDURE  WRiTEMAP; 

VAR  wp:  workp; 

B:  BOOLEAN; 
BEGIN 

WITH  SEGINFOCSD'^  DO 

wp^-r^PROcsf '  '^"  **  ''^''*  ''  srcfile'^.segtbl.segnamecsrcsegd); 

IF  WP  <>  NIL  THEN 

WRITELN(MAP,  •    SEP  PROCSM; 
WHILE  WP  <>  NIL  DO 


oc3 


"-TO  i 


2251 

48:? 

26 

2252 

46:5 

32 

2253 

43:4 

32 

2254 

46:4 

59 

2255 

48:5 

6b 

2256 

48:4 

61 

2257 

48:5 

83 

2258 

48:4 

99 

2259 

48:4 

23 

2260 

48:4 

55 

2261 

48:4 

87 

2262 

48:4 

94 

2263 

48:3 

95 

2264 

48:i 

00 

2265 

48:2 

11 

2266 

48:3 

11 

2267 

48:4 

14 

2268 

48:5 

14 

2269 

48:5 

19 

2270 

48:6 

24 

2271 

48:4 

58 

2272 

48:3 

58 

2273 

48:4 

60 

227f 

48:5 

60 

2275 

48:5 

65 

2276 

48:6 

70 

2277 

48:4 

05 

2278 

48:3 

05 

2279 

48:4 

10 

2280 

48:5 

16 

2281 

48:6 

16 

2282 

48:6 

43 

2283 

48:6 

47 

2284 

48:6 

47 

2285 

48:6 

49 

2286 

48:6 

84 

2287 

48:6 

19 

2288 

48:6 

54 

2289 

48:6 

89 

2290 

48:7 

13 

2291 

48:7 

27 

WITH  WP'^.DLFSYM'^. ENTRY  DO 
3EGIN 

WRITE(MAP,  '       •.  NAME) 
IF  LITYPE  =  SEPPROC  THEN 
WRITL(MAP,  •  PROCM 

ELSE 

WRITE(MAP. 
WRITECMAP,  • 
I/JRITE(MAP,  ' 
WRITE(MAP,  • 
WRITELNCMAP) ! 


ft 


FUNC  ) ; 

•,  WP'^.NElAiPROC:  3) 


BASE 
LENG 


—  I 

—  t 


PLACE''. DtSTBASEJ  6); 

PLACE'*. length:  5)  ; 


WP 

end; 

FOR  B 
BEGIN 
IF  B 


:=  WP-,NEXT 


=  FALSE  TO  TRUE  DO 


THEN 
BEGIN 

WP  :=  OTHER; 

IF  WP  <>  NIL  THEN 
WRITELN(MAPf  • 
END 
ELSE 
BEGIN 

WP  :=  LOCAL; 
IF  WP  <>  NIL  THEN 
WRITELN(MAP»  • 
END; 
WHILE  WP  <>  NIL  DO 

WITH  WP'^.DEFSYM'*. ENTRY 
BEGIN 

WRITE(MAP,  • 
CASE  LITYPE  OF 
SEPPROC, 
SEPFUNC: 
PUBLDEF: 
CONSTDEFl 
PRIVREF: 
UNITREF: 
6L0BDEF: 


SEP  PROC  REFS* ) 


LOCAL  SEG  REPS' ) 


DO 


NAME) 


WRITE(MAP»  »  PUBLIC  LC  =•» 
WRITE(MAP»  ♦  CONST  VAL  =»i 
WRITE<MAPt  '  PRIVAT  LC  =». 
WRITE(MAP»  *  UNIT  SE6«  =»♦ 
WRITE(MAP»  '  GLOB  DEF  IN  •, 

WP'^.DEFPROC.DEFSYM'*,  ENTRY. NAME, 

•  a»,  icoffset:  s) 


baseoffset:  5); 
constval:  6); 
wp'^.newoffset:  5) 
wp'^.defsegnum:  3) 


2292  1    4816     50  £Nij; 

2293  1    ^8:6     d^  wRlTELNd^'AP) 

2294  1    i+eib     91 


i^.P  :=  WP^.NEXT 


2295  i  <+8:5  92  E.jC 

229b  i  48:2  9b  END: 

2297  i  43:i  0'+  WRITELN(MAP) 

2298  1  4a:o  11  eind  C  WRITEMAP  3  ; 

2299  1  48:o  40 

2300  1  47:o  0  BEGIM  C  LINKSEGWIENT  2 

2301  1  47:i  0  SEPHOST  :=  FALSE! 

2302  1  47:1  ^  SEG3ASE  :=  NIc; 

2303  1  47:i  8  SEGLENS  :=  O; 

2304  1  47:i  12  IF  TALKATIVE  THEN 

2305  1  47:2  15  wjTH  SEGINFOCSJ'^  DO 

2306  1  47:3  28  WRITELN( 'LINKING  •» 


2307    1    47:3     46 


2308  1  47:i  94  BUilDWORKLISTS ; 

2309  1  47:i  96  IF  ERRCOUNT  =  0  THEN 

2310  1  47:2  01  BEGIN 

2311  1  47:3  01  READSRCSES; 

2312  1  47:3  03  IF  MAPNAME  <>  '♦  THEN 

2313  1  ^7:t|  12  WRITEMAP; 
231tf  1  47:3  m  COPYINPROCS; 

2315  1  47:3  16  FIXUPREFS (LOCAL ,  TRUE); 

2316  1  47:3  22  FIXUPREFS{ OTHER t  FALSE); 

2317  1  47:3  28  WRITETOCOQE 

2318  1  47:2  28  end; 

2319  1  47:1  30  IF  SEPHOST  THEN 

2320  1  '+7:2  35  SEPLIST  :=  SEGINFOC  S^'^.NEXT ; 

2321  1  47:1  ^+9  RELEASE(HEAP3ASE) 

2322  1  47:0  51  END  C  LINKSEGMENT  J  ; 

2323  1  47:0  66 

2321  1  28:o  0  BEGIN  C  PHASES  2 

2325  1  28:i  0  IF  NOT  USEWORKFILE  THEN 

2326  1  28:2  17  BEGIN 

2327  1  28:3  17  WRITE( »OUTPUT  FILE?  •); 

2328  1  28:3  10  REaDLN(FNAME ) ; 

2329  1  28:3  55  USEWORKFILE  :=  FNAME  =  •* 

2330  1  28:2  57  end; 

2331  1  28:i  64  IF  USEWORKFILE  THEN 

2332  1  28:2  67  REWRITE(C0DE,  • *SYSTEM.WRK.C0DEC*3» ) 


SRCFILE^.SEGTBL.SEGNAMECSRCSEGD*  •  »  »»  S) 


:'^R 


23i3 

233'+ 

2335 

2336 

2337 

2338 

2339 

2340 

2341 

2342 

2343 

2344 

2345 

2346 

2347 

2348 

2349 

2350 

2351 

2352 

2353 

2354 

2355 

2356 

2357 

2358 

2359 

2360 

2361 

2362 

2363 

2364 

2365 

2366 

2367 

23d8 

2369 

2370 

2371 

2372 

2573 


28 

28 

28 

28 

28 

28:2 

28:2 

28:i 
28:i 
28:i 
28:i 

28:2 
28:3 
28:4 
28:4 
28:3 

28:i 

28:2 

28:3 

28:3 

28:4 

28:5 

28:5 

28:4 

28:3 

28:4 

28:5 

28:5 

28:6 

28:5 

28:6 

28:5 

28 

28 

28: 

28 

28: 
28: 

28 


;4 

12 

1 
1 
1 
1 

;2 


28; 
28; 


96 
98 
07 
13 
13 
.51 
35 
35 
38 
38 
47 
47 
67 
67 
88 
97 
06 
15 
15 
25 
31 
31 
67 
69 
74 
76 
76 
99 
04 
29 
31 
57 
63 
63 
63 
67 
75 
75 
95 
06 
20 


ELSE 

REWRlTE(CODEi  FrjAML)  ; 
IF  lOR^SULT  <>  0  THEN 

ERROR ('CODE  OPEN  ERR*)? 
EXIT(LINKER) 

Ei-jo; 
NEXTBLK  :=  i; 

C  CLEAR  OUTPUT  SEG  TABLE  1 
FILLCHAR(SEGTBLi  SIZEOF ( SEGTBL ) t  0); 
WITH  SEGTBL  DO 

FOR  S  :=  0  TO  MAXSEG  DO 
BEGIN 

SEGNAMECS3  :r  ♦         •; 
SEGKINDCSJ  :=  LINKED 
END; 
IF  MAPNAME  <>  ••  THEN 
BEGIN 

REwRlTE(MAPt  MAPNAME); 
IF  lORESULT  <>  0  THEN 
BEGIN 

WRITELN('CAN'»T  OPEN  S  MAPNAME); 
MAPNAME  :=  •• 
END 
ELSE 
BEGIN 

WRITE(MAP,  'LINK  MAP  FOR  ♦); 
IF  HOSTSP  <>  NIL  THEN 

WRITELN(MAPf  HOSTSP*^. SRCFILE'^, SEGTBL. SEGNAMECHOSTSP''. SRCSEG D  ) 
ELSE 

WRITELN(MAP»  ♦ ASSEM  HOST*  )  J 
WRITELN(MAP) 
END 

end; 
mark(Heapbase) ; 

UNlTWRlTE(3i  HEAPBASE'",  35); 
C  LINK  ALL  BUT  HOST  3 
FOR  S  :=  0  TO  MAXSEG  DO 

IF  (SEGINFOCSD  <>  NIL) 

AND  (SEGINF0CS3  <>  HOSTSP)  THEN 
LIMKSEGMENT; 
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29 
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34 
34 
40 
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42 
iil 
68 
37 
92 
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<> 


RESTORE 
1  THEN 


C  LINK  HOST  L/^ST!  3 
IF  MOSTSP  <>  NIL  THLN 
c3E&lN 

S  :=  MA3TCRSEG; 

LINKSE&MENT 

IF  FLIPPED  THEN  FlIPTABlE ( SEGT3L ) ; 
IF  BLOCKWRITE(COOEt  SEGTBLt  1,  0) 

ERRORCCODE  WRITE  ERRM  ! 
IF  ERRCOUNT  =  0  THEN 

BEGIN  C  FINAL  CLEANUP  D 
CLOSE(CODE»  LOCK); 
IF  IJSEWORKFILE  THEN 
WITH  USERINFQ  DO 
BEGIN 

GOTCODE 
CODEVID 
CODETID 

end; 

IF  mAPNAME  <>  •» 
BEGIN 

IF  HOSTSP  <> 

WRITELN(MAP.  'NEXT  BASE  LC  =  » i  NEXTBASELC); 
CLOSE(MAP»  LOCK) 
END 
END 

END  C  PHASE3  3  ; 

CSI  LINK3B  3 

BEGIN  C  LINKER  1 

PHASEl; 

PHASE2; 

PHASE3; 

UNITCLEAR(3) 
END  C  LINKER  1    ; 

BEGIN  END, 


BYTE-FLIPPED  STATE  1 


TRUE; 

syvid; 

•system. wrk. code* 

THEN 
NIL  THEN 
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As  OF  THE  PRINTING  OF  THIS  BOOK> 

THE  .Assembler  was  not  listed. 

The  Assembler  may  be  available 
at  a  later  date  in  a  suppliment 
at  additional  cost, 

Thank  you  for  your  patience,  ed. 
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KENNETH  L.  BOWLES,  DIRECTOR 
CONST 


MMAXINT  =  32767; 
MAXJNIT  =  12; 
MAXDIR  =  77; 
vidlens  =  7; 


(♦MAXIMUM  INTEGER  VALUE*) 
(♦MAXIMUM  PHYSICAL  UNIT  U    FOR  UREAD*) 
(*MAX  NUMBER  OF  ENTRIES  IN  A  DIRECTORY*) 
(♦NUMBER  OF  CHARS  IN  A  VOLUME  ID*) 
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TYPE 


■■"AXSEG  -  1'^; 
FBLKSlZt.  =  512; 
DIF^SLK  =  2; 
AGElI^'^IT  =  300; 
tOL  =  15; 
DLE  =  16; 
NAMr_LEN  =  23; 
FILL.LEfM  =  11  ; 


(*NijMjE'^  OF  CHARS  I PJ  TITLE  ID*) 

(*MAX  CODE  SEGMENT  NUMBER*) 

(♦STANDARD  DISK  3L0CK  LENGTH*) 

(♦DISK  ADOR  OF  DIRECTORY*) 

(♦MAX  ASE  FOR  GDIRP...IN  TICKS*) 

(*ErjD-GF-LlNE.. .ASCII  CR*) 

(♦BLANK    COWiPRESSlON    CODE*) 

CLENGTH  OF  CONCAT ( VIOLENGt • : » » TIDLENG ) D 

CMAXIMUM  n    OF  NULLS  IN  FILLERS 


lORSLTWD  =  (inoeRRor,ibadblock.ibadunit,ibadmode»itimequt, 

ILOSTUNITflLOSTFILE.IBADTITLEflNOROOMiINOUNIT, 
INOFlLEtlDUPFlLEflNOTCLOSEDtlNOTOPENilBADFORMAT, 

ISTRGOVFL) ; 

(♦COMMAND  STATES. ..SEE  GETCMD*) 

CMOSTATE  =  (HALTINIT.DEBUGCALLt 

UPROGNOU,UPROGUOK»SYSPROGt 
COMPONLY,COMPANOGOtCOMPDEBUG» 
LiNKANDGOtLlNKDEBUG) ; 

(♦CODE  FILES  USED  IN  GETCMD*) 

SYSFILE  =  (ASSMBL.ERfCOMPlLERiE0ITOR,FILER«LlNKER)  ; 

(♦ARCHIVAL  INFO. ..THE  DATE*) 


DATerEC  =  PACKED  RECORD 

month:  0..12; 

DAY:  o.,3i; 
year:  0..100 
end  (*daterec*) 


UNIT^mUWI  =  O..MAXUNIT; 

viD  =  stringcvidlengd; 


(*0  IMPLIES  DATE  NOT  MEANINGFUL*) 

(♦DAY  OF  MONTH*) 

(*100  IS  TEMP  DISK  FLAG*) 


(♦VOLUME  TABLES*) 


(♦DISK  DIRECTORIES*) 
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i:d 

1 

120 

0 

i:d 

1 

121 

0 

i:q 

1 

122 

0 

i:d 

1 

OIR^^^ANGc;  =  0.."!AXDIR; 
TIJ  z  STiUU^CTluLtNGj; 
FJLl.ID  -  ST!U;JGLNAW!E_LEf.Jj; 

FILc-TA.-jLt  =  ARRAY  CSYSFILEJ  OF  FULL_ID; 


fil!:kii\Id  = 


(UNTYPi^DFILE.XDSKFILEiCODEFILEfTEXTFlLE, 
IfJF0FlLE,DATAFlLE»GRAFFlLE,F0T0FlLE,SECUREDIR) 


DiRENTRy  = 


packed  record 
dfirstblk:  in 

OLASTBLK:  INT 
CASE  DFKIND: 
SLCUREDIR, 
UNTYPEDFILE 
(FILLERI 

dvid:  V 

DEOVBLK 

DNUMFIL 
DLOADTI 

dlastbo 

XDSKFILEtCO 
DATAFILE1GR 
(FILLER2 
STATUS 

dtid:  T 

DLASTBY 

DACCESS 
END  (*UIRENTRY* 


teger;  (*first 
eger;  (*point 
filekino  of 

:  (*only  in  dirc 

:  0,.2048;  CFOR 

id; 

:  INTEGER; 
ES:  DIRRANGE; 

ME:  integer; 

OT:  DATEREC); 
DEFILE, TEXTFlLEf 
AFFlLEtFOTOFlLE: 
:  0,,l02tf;  CFOR 
:  BOOLEAN; 
ID; 

TE:  1..FBLKSIZE; 
:  DATEREC) 

)  ; 


PHYSICAL  DISK  ADDR*) 
S  AT  BLOCK  FOLLOWING*) 


OD.. .VOLUME  INFO*) 

DOWNWARD  COMPATIBILITY, 13  BITS3 

(*NAME  OF  DISK  VOLUME*) 

(*LASTBLK  OF  VOLUME*) 

(*NUM  FILES  IN  DIR*) 

(♦TIME  OF  LAST  ACCESS*) 

(*MOST  RECENT  DATE  SETTING*) 
INFOFILE, 

DOWNWARD  compatibility: 

CFOR  FILER  WILDCARDS^ 
(*TITLE  OF  FILE*) 
(*NUM  BYTES  IN  LAST  BLOCK*) 
(*LAST  MODIFICATION  DATE*) 


DiRp  =  '^directory; 

DIRECTORY  =  ARRAY  CDIRRANGEJ  OF  DIRENTRY; 

(♦FILE  INFORMATION*) 
CLOSETYPE  =  (CNORMAL, CLOCK, CPURGE,CCRUNCH); 

rtiNDowp  =  '^window; 

window  =  packed  array  c  0 ,  .  0  !]  of  char; 

fibp  =  '^fib; 
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i:d 
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i:d 
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i:d 

loO 

0 

i:d 

161 

0 

i:j 

162 

0 

i:d 

163 

0 

1:  J 

Fi: 


F'.-.r-ij 
Flop, 

FSTAT 

FRLCS 
CASE 
TRU 


F£0L 

E:  ( 
ize: 
Fiso 
E:    { 


WIUDOWP 

w:   ijooL 

FJAMDwt 
IWTEGE 

pen;  bo 

FISBLKD 

funit: 
fvid:  V 

FREPTCN 
FNXTBLK 
FMAXBLK 
FMODIFI 
F HEADER 
CASE  FS 

true: 


TCHAR) ; 

...C=>BLOCKFlLEt  1=>CHARFILE* ) 


;        (*USER    WIijDOW.  ..F''*    USED    BY    GET-PUT*) 

EA'^; 

FNEEDCHARtFeO 

r;    (*in  bytes 

OLEAN    CF 

:   boolean; 

uimitnum; 

id; 

T» 


{* 
(* 
(* 
(* 
(* 
(* 
(* 


:   integer; 

ed:bgolean 

:  direi\jtry;(# 

0ft3uf:  boole 

(fnxt3yte»fm 

fbufchngd: 

fbuffer;  pa 


FILE  IS  ON  BLOCK  DEVICE*) 
PHYSICAL  UNIT  #*) 
VOLUME  NAME*) 

U    TIMES  F-  VALID  W/0  GET*) 
NEXT  REL  BLOCK  TO  10*) 
MAX  REL  BLOCK  ACCESSED*) 
PLEASE  SET  NEW  DATE  IN  CLOSE*) 
COPY  OF  DISK  DIR  ENTRY*) 
AN  OF  (*DISK  GET-PUT  STUFF*) 
AXBYTE:  INTEGER; 
BOOLEAN; 
CKED  ARRAY  CO. .FBLKSIZED  OF  CHAR)) 


END  (*FIB*)  ; 


(*USER  WORKFILE  STUFF*) 


INFoREC  =  RECORD 

symfibp.codefibp:  fibp; 
errsym,errblk«errnum:  integer; 
slowterm, stupid:  boolean? 
altmode:  char; 
gotsym,gotcode:  boolean? 
workvid»symvid,codevid:  vid; 
i«/orktid,symtid,codetid:  tid 
end  (♦inforec*)  ; 


(*workfiles  for  scratch*) 

(♦error  STUFF  IN  EDIT*) 
(♦STUDENT  programmer  ID!!*) 
(*WASHOUT  CHAR  FOR  COMPILER*) 
(*TITLES  ARE  MEANINGFUL*) 
(*PERM&CUR  WORKFILE  VOLUMES*) 
(*PERM&CUR  WORKFILES  TITLE*) 


SEGraNGE  =  cmaxseg; 

SEGDESC  =  RECORD 

diskaddr: 


integer; 


CODELENG:  INTEGER 
END  (*SEGDESC*)  ; 


(*CODE  SEGMENT  LAYOUTS*) 


{*REL  BLK  IN  CODE...ABS  IN  SYSCOM'^*) 
(*#  BYTES  TO  READ  IN*) 


(^DEBUGGER  STUFF*) 
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i:j 

1 

17£+ 

3 

i.-w 

1 

175 

0 

i:q 

1 

176 

G 

i:d 

1 

177 

0 

i:ij 

1 

178 

0 

i:d 

1 

179 

0 

i:o 

1 

180 

0 

1:3 

1 

181 

0 

i:d 

1 

182 

0 

i:d 

1 

183 

0 

1:0 

1 

184 

0 

1:0 

1 

185 

0 
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i:d 

1 

193 

0 

1:0 

1 

19^ 

0 
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CYT-:^l^iKiZ    =  0..25S; 

T-aCKAR-^AY  -  RZCOKD         CMlMQRY  DIDDLING  FOR  EXECERRORD 
CASt.  f:0OLEA■^l  OF 

FRUF  :  (wOKD  :  ARRAY  C 0 . . 0  J  OF  INTEGER)? 

FALSE  :  (BYTE  :  PACKED  ARRAY  E0..0J  OF  3YTERAiM6E) 


(*?^(ARK  STACK  RECORD  POINTER*) 


END 
MSCrtP  =  *  MSCW; 
f'^SCi-j  =  RECORD 

STATLIfvK;    MSC/iP;        (♦POINTER    TO    PARENT    MSCW*) 

dynlink:  ^scwp;   {*pointer  to  caller»s  mscw*) 
msseg,msjta3:  ''trickarray ; 
msipc:  integer! 
localdata;  trickarray 

END  (*MSCW*)  ; 

(♦SYSTEM  communication  AREA*) 
(♦SEE  INTERPRETERS... NOTE  *) 
(♦THAT  WE  ASSUME  BACKWARD 
(♦FIELD  allocation  IS  DONE 


SYSCOMREC  =  RECORD 

ICRSLT:  lORSLTWD; 

xeqerr:  integer; 
sysunit:  unitnum; 
bugstate:  integer; 
gdikp:  dirp; 
lastmp.stkbase.bombp: 


♦  ) 
*) 


{♦result  of  last  id  CALL^) 
{♦reason  for  EXECERROR  CALL^) 
{♦physical  unit  of  BOOTLOAD*) 
(♦debugger  info*) 

{♦global  dir  pqinterfsee  v0lsearch+) 
Mscwp; 


INTEGER; 

(♦WHERE  XEQERR  BLOWUP  WAS^) 
{♦MORE  DEBUGGER  STUFF^) 
OF  INTEGER; 

(♦DRIVERS  PUT  RETRY  COUNTS^) 
.8J  OF  INTEGER; 


memtop,seg,utab: 

BOMBIPc:  INTEGER* 
HLTLINE:  INTEGER; 
BRKPTS:  ARRAY  CO, .3D 
retries:  INTEGER; 

expansion:  array  eg., 
hightime,lowtime:  integer; 
miscinfo:  packed  record 

MOBREAK. stupid iSLOWTERM. 

hasxycrt»haslccrt,has851oa,hasclock:  boolean; 

USERKIND: (NORMAL.  AQUIZ.  BOOKER,  PQUIZ); 
IS_FLIPT  :  BOOLEAN 
END; 
CRTTYPe:  INTEGER; 
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1 

SYSC3 

233 

0 

D 

2 

GFILl 

23"+ 

0 

D 

8 

USERl 

235 

0 

D 

54 

EfJlPTY 

236 

0 

,D 

55 

INPUT 

237 

0 

;d 

55 

syste: 

238 

0 

;d 

59 

SYVIO 

239 

0 

67 

THEDa 

2^0 

0 

;d 

68 

DEBU3 

241 

0 

;d 

69 

state: 

242 

0 

;d 

70 

pl:  5 

243 

0 

D 

111 

IPOT: 

244 

0 

u 

116 

fille 

245 

a 

D 

122 

OIGIT 

CfdCTRL:  PACKEG  RECORD 

RLFfiMOFStERASEEGL.ERASEEOSf  HOME,  ESC  APE:  CHAR 
3i\CKSPACE:  CHAR; 

fillcount:  q,.255; 
clearscreen.  clearline:  char; 
prefixed:  packed  array  [:o..8D  of  boolean 
end; 
crtinfo:  packed  record 

«jidth,heisht:  integer; 
RIGHT, left, QOWNtUP:  char; 

BADCH,CHARDEL, stop, BREAK, FLUSH, EOF:  CHAR; 

altmode,limedel:  char; 

BACKSPACE, ETX, prefix:  CHAR; 

prefixed:  PACKED  ARRAY  CO, .133  OF  BOOLEAN 

END; 

SEGTABLE:  ARRAY  CSEGRANGED  OF 
RECORD 

CODEUNIt:  UNITNUM5 
CODEDESc:  SE6DESC 
END 
(♦SYSCOM*) J 


END 


=  RECORD 

msyscom: 

end; 


syscomrec 


m:  -^syscomrec; 

s:  ARRAY  CO. .53  OF  FIBP; 
NFO:  INFORECi 

heap:  '^integer; 
fib,0utputfib' 

RM,SyMAPFIB:    FIBP; 

.dkvid:  VID; 
te:  daterec; 

info:  -^INTEGER; 
:  CV.DSTATE; 
TRING; 

array  co. .43  of  integer 
r:  stringcfill-len]; 
s:  set  of  'o'.. 'g* ; 


(♦MAGIC  PARAM...SET  UP  IN  BOOT*) 
(♦GLOBAL  FILES*  0=INPUT,  1=0UTPUT*) 
(♦WORK  STUFF  FOR  COMPILER  ETC*) 
(♦HEAP  MARK  FOR  MEM  MANAGING*) 
(♦CONSOLE  FILES. ..GFILES  ARE  COPIES^) 
(♦CONTROL  AND  SWAPSPACE  FILES*) 
(♦SYSUNIT  VOLID  &  DEFAULT  VOLID^) 
(♦TODAY. ..SET  IN  FILER  OR  SIGN  ON*) 
(♦DEBUGGERS  GLOBAL  INFO  WHILE  RUNIN+) 
(♦FOR  GETCOMMAND^) 

(♦PROMPTLINE  STRING. ..SEE  PROMPT^) 
(♦INTEGER  POWERS  OF  TEN^) 
(♦NULLS  FOR  CARRIAGE  DELAYS) 


246    u     l;3    1 

^■^-^  :•         i:„   i; 

2bG    M     i:  } 


2c.^  (*  SYSTl^i  procedure  FORWARD  DECLARATIONS  *)   *' 

26^  (*  THESE  ARE  ADDRESSED  BY  OBJECT  CODE...  *) 


U-^jITa'--lE:     ARr<AY    LUNITNU[-3    0^     (*0    NOT    USEn*) 
KECJRD 

^jvid:  vid;    {*\/clume  id  for  unit*) 

^•^^  CASE  UlsBLKu:  BOOLEAN  OF 

^'^■'^  ThUE:  (UL0V3LK:  INTEGER) 

..r.,,.       ,     ...    ;^&  END  (*UNITABLl*)  ; 

';^':    '^     -^-^    2j'+  FlLEr.jA.^E  :  FILE.TABLE; 

25'+    0     l:j    264  (* 

255  I  l:'j 

256  0    i:d 

^11       ^    J-^   2o4  (♦  00  Not  move  without  careful  thought'  *) 
■^^^  ^         2:d     1  procedure  EXECERROR; 

26C    0     2:D      1    FORWARD; 

262   0    s^o    :  ^^poruaS-  ''^'^^t<^a«  f:  fis;  window:  windowp;  recwords:  integer); 

'^     J      J.iJ       4     rURWARG; 

^f^         °     '+5Q      1  procedure  FRESET(VAR  F:  FIB); 
2&*+    0     f+ro      2    FORWARD; 

p!^   0    11^  1  procedure  fopencvar  f:  fib;  var  ftitle:  string; 

ill      0   l':o  5   forward;     '''''°''^  '°°'"''  ''''^  "''" 

^ff   ^   ^-^    1  procedure  fclose(var  f:  fib;  ftype:  closetype); 

2b9  Q  6:D  3    FORWARD; 

270  0  7:d  1  PROCEDURE  FGET(VAR  F:  FIB); 

271  0  7:d  2    FORWARD; 

272  0  8:D  1  procedure  FPUT(VAR  F:  FIB); 

273  0  8:d  2    FORWARD; 

27^+    0     9:d      1  PROCEDURE  XSEEK; 

275    C     9:D      1    FORWARD; 

^1°         ^         ^0-^      3  FUNCTION  FEOF(VAR  F;  FIB):  BOOLEAN; 

277   0   io:d    h       forward; 


278   0   ii:d 


279    0    ll:o      4    forward; 


3  FUNCTION  FEOLNCVAR  F:  FIB):  BOOLEAN; 


280  0    12:D 

281  0    12:0      3    FORWARD; 

282  0    13:D 


1  PROCEDURE  FREADINT(VAR  F:  FIB;  VAR  I:  INTEGER); 


283  0  1,.-.  J  ^^cro^'^o^  FWRITEINT{VAR  F:  FI3;  I,RLENG:  INTEGER); 

'^■J  u  io.b  M-    FORWARD; 

2^"+  0  l'+:0  1  PROCEDURE  XRrADREAL; 

235  0  m:D  1    FORWARD; 

2^^  ^  1^:D  1  PROCEDURE  XWRITEREAL; 


337 
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u 

15 

:  (J 

^3a 

:1 

16 

259 

J 

16 

[  ., 

290 

!j 

17 

: ' J 

2^1 

0 

17 

:li 

292 

.  0 

ia 

:  J 

293 

0 

13 

:  J 

29tf 

3 

19 

:a 

295 

3 

19 

:d 

296 

0 

20 

:d 

297 

0 

20 

:d 

298 

0 

21 

;d 

299 

0 

21 

300 

0 

22 

:d 

301 

0 

22 

;d 

302 

0 

23 

.0 

303 

0 

23 

:o 

30t» 

0 

2f 

ID 

305 

0 

24; 

.0 

306 

0 

25! 

:d 

307 

0 

25; 

D 

308 

0 

26; 

D 

309 

0 

26; 

D 

310 

0 

27; 

D 

311 

Q 

27; 

D 

312 

u 

28; 

D 

313 

0 

28; 

D 

Sit 

0 

28; 

315 

0 

29; 

D 

316 

0 

29; 

0 

317 

0 

29; 

D 

318 

0 

29; 

D 

319 

0 

29; 

0 

320 

0 

30; 

D 

321 

0 

30; 

D 

322 

0 

3o; 

D 

323 

0 

31; 

324 

0 

31; 

D 

325 

0 

32: 

D 

326 

0 

32: 

D 

327 

'J 

33: 

n 
^ 

1   foR/jaR:; 

1  h-'f^DCEDU^:. 

3  FO,-JwAK.; 
1  pROCEIDURl 

4  FORwARj 
1  PROCEDURE 
4  FORWAR:) 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 

5  FORWARD 

1  PROCEDURE 

2  FORWARD 

1  PROCEDURE 

2  FORWARD 
1  PROCEDURE 

4  FORWARD 
1  PROCEDURE 

5  FORWARD 
1  PROCEDURE 
5  FORWARD 
1  PROCEDURE 
4    FORWARD 

3  FUNCTION  S 


FRCADCMAR(  v'\H  F:  flQ;  \/AR  CM:  CHAR); 

FWPITCCHAR( VAR  p:  Fl3;  CH:  CHAR;  RLENG:  INTEGER); 

FREADSTRIiJGCVAR  F:  FI3;  VAR  S:  STRING;  SLENG:  INTEGER); 

fwritestrimg(vap  f:  fi3;  var  s:  string;  rleng:  integer); 

FWRITE3YTZs(VAR  F:  FI3;  VAR  A:  WINDOW;  RLENG. ALENG:  INTEGER); 

freadln(Var  f:  fib) ; 

fwriteln(vaR  f:  fib) ; 

sconcat(var  dest.src:  string;  destleng:  integer); 

sinsertcvar  src.dest:  string;  destleng.insinx:  integer); 

scoPY(VAR  src.dest:  string;  srcinx.copyleng:  integer); 

sdelete(Var  dest:  string;  delink. delleng:  integer); 

pos(VAR  target. sRc:  string):  integer; 


5  forward, 

3  function  fblockio(Var  f:  fib;  var  a:  window;  i:  integer; 

6  nblocks.rblock:  integer;  doread:  boolean):  integer; 

9  FORWARD; 

1  PROCEDURE  FGOT0XY(X,y:  INTEGER); 

5  FORWARD; 

3 

3  (*  NON  FIXED  FORWARD  DECLARATIONS  *) 

3 

3  FUNCTION  VOLSEARCH(VaR  FVID:  VID;  LOOKHARD:  BOOLEAN; 

5  VAR  fdir:  DIRP):  UNITNUM; 

6  forward; 

1  PROCEDURE  WRITEDIR(FuNIT:  UNITNUM;  fdir:  dirp); 

3  FORWARD; 

3  FUNCTIO'-J  nIRsEARCH(VAR  FTID:  TID;  FINDPERM:  BOOLEAN;  FDIR:  DIRP):  DIRRANGE; 

6  FORWARD; 

3  FUNCTION  sCAfvlTITLECFTlTLE:  STRING;  VAR  FVID:  VID;  VAR  FTID:  TID; 


52:i 

Q 

5'6i:: 

■L. 

iiO 

■  J 

33:  ) 

4  > 

330 

"J 

34  :c. 

i 

331 

;"} 

34:,: 

3 

ii?^ 

n 

i^::. 

1 

333 

i-1 

^d:  : 

4 

334 

^ 

^ 

36:  [j 

1 

335 

0 

36  :d 

1 

336 

G 

37:0 

1 

337 

w 

37  :d 

1 

333 

J 

38:d 

1 

339 

•« 

J 

38  :d 

1 

X 

34U 

0 

39  :o 

1 

3H1 

0 

o9:j 

1 

342 

0 

4o:d 

3 

343 

0 

40  :d 

4 

344 

0 

4i:o 

3 

345 

0 

'+i:d 

4 

346 

0 

'+2:d 

3 

347 

0 

42:d 

348 

0 

'+3:d 

349 

0 

43:D 

350 

0 

t+SlD 

351 

0 

f3:o 

352 

0 

^+3:0 

353 

0 

43:o 

354 

0 

'+3:d 

355 

0 

'+3:d 

356 

i:d 

357 

i:d 

358 

i:d 

359 

i:d 

360 

i:a 

361 

i:o 

362 

i:j 

363 

i:d 

364 

i:q 

365 

i:d 

366 

i:o 

367 

i:d 

368 

i:d 

P^^,.,_^^^,,.  ^^''  fslGs:    rNiiLfJER;   var  fkimd:   filekino:   boolean? 

^ROCEDJr^-  CtLFrjT'iY(Fir.X:  DIRR,,N3E;  fdir:  dirp): 

FORi:.AHj; 

"'fSrwar?, ''"'''""""'''"  ''^'"''-  ^^^^'^"^^^^  "^X:  DIRRANGE;  fdir:  DIRP); 
PROCEDURE  riO^'iECURSOR; 
FORu'ART; 

PROCEDURE  CLEARSCREEN; 

FORWARD; 
PROCEDURE  CLlARLINE; 

FORrtARO; 
PROCEDURE  PRO  HPT; 

FORWARD; 

FUNCTION  SPACEWAIT(FLUSH:  BOOLEAN):  BOOLEAN; 

FORWARD; 
FUNCTION  GETCHAR(FLUSH:  BOOLEAN):  CHAR; 

FORWARD; 

FUNCTION  FETCHDIR(FUNIT:UNITNUM)  :  BOOLEAN; 

FORWARD; 
PROCEDURE  COMMAND; 

FORWARD; 


{*SI  GLOBALS.TEXT*) 
{* 


■*) 


SEPARATE  UNIT  PASCALIO; 
INTERFACE 

TYPE  DEC'^AX  =  INTEGERC36D; 

STUNT  =  RECORD  CASE  INTEGER  OF 


{W2 
(ifl/3 

(W5 
(W6 

(we 

(  W9 


INTEGERC4D) ; 
INTEGERCS:) ; 
INTEGERE123) ; 
INTEGERC16:) ; 
INTEGERC203) ; 
INTEGERC243) ; 
INTEGERC263) ; 
INTEGERC323) ; 


joy 


370 
o71 
372 
573 
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377 
37B 
379 
330 
381 
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383 
38^ 
385 
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387 
388 
389 
390 
391 
392 
393 
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395 
396 
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398 
399 
400 
401 
f02 
403 
404 

406 
407 
408 
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1 
i 
1 
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1 
1 
1 
1 
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1 
1 
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1 
1 
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1 
1 
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1 
1 
1 
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1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
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1 

1 
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1 

:o 
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:d 
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'.J 
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:d 
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:d 

7 

:d 

7 

:j 

1 

:d 

1 

:d 

6 

:d 
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;d 

6 

:d 

6: 

'0 

61 

1 

6: 

1 

6; 

1 

6: 

1 

6: 

0 

6: 

0 

6; 

;o 

8! 

ID 

8; 

;o 

8; 

1 

8. 

'0 

a; 

0 

7; 

0 

7; 

.D 

7; 

D 

7: 

0 

7. 

'1 

7; 

1 

7: 

1 

7; 
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7: 

1 

7: 

7: 

1 

1 
1 

6 

3 

5 

5 

1 

3 

5 

5 

0 

0 

19 

38 
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62 

74 

74 

3 

0 

Q 

23 

36 

3 

5 
5 

0 

0 

7 

16 

21 
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37 
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u  "J^  ' 


FSEEK(\/AR  f:  fis;  recnum: 
freadreal(Vap  F:  fib;  var 
fwritereal(var  f:  fi3;  x: 

FREADDEC(VAR  F:  FI3;  VAR 
FWRITEDEC(VAR  F:  FI3!  D: 


PROCEDURE 

PROCEDURE 

PHOCEDjhE 

PPOCEDJRL 

PROCEDURE 

FUrJCTlON  SUPER-^0D(At8 

FUNCTlOf^i  SUPER_DI\/(A.B 


INTEGER) 
INTEGER) 


INTEGER) 5 
X:  REAL); 

real;  w,  D:  integer); 
D:  stunt;  L;  INTEGER); 
DECViAX;  RLENG:  INTEGER); 

INTEGER; 

INTEGER; 


IMPLEMENTATION 

FUNCTION  SUPER-MODuAtB  :  INTEGER) 
CCALCULATES  A*B  MOD 


:  INTEGER]; 
512  WITH  0  <= 


A»B  <=  MAXINTD 


VAR   TEMPI,  TEMP2,  TEMP3  :  INTEGER? 

BEGIN 

TEMPI  :=  (A  MOD  1024  DIV  32) 
TEMP?  :=  (A  MOD  32)  *  (B  MOD 
TEMP3  :=  (A  MOD  32)  *  (B  MOD 


*  (B  MOD  32)  *  32 
1021  DIV  32)  *  32 
32)  MOD  512; 


MOD 
MOD 


5125 
512; 


super.mod 

END    EOF 


:=  (TEMPI  + 
SUPER. M0D3; 


TEMP2  +  TEMP3)  MOD  512; 


FUNCTION  LITTLE«DIV(A,B,C  :  INTEGER)  I  INTEGER; 
BEGIN 

LITTLE-DIV  :=  (A  MOD  512  +  3  MOD  512  +  C  MOD  512)  DIV  512; 

END   LOF  LITTLE_DIV3; 

FUNCTION  SUPER-OlVCAiB  :  INTEGER)  :  INTEGER3; 

CCALCULATES  A*8  DIV  512  WITH  0  <=  A*B  <=  2**24] 
VAR   A_HI,  A.MID,  A-LOW,  B.Hlt  B_MIDf  B_LOW  :  INTEGER; 
BEGIN  COF  SUHER.DIV: 

A_HI  ;=  A  DIV  102'+' 

A_MlO  :=  A  MOO  102t  DIV  32; 

A_LOw  :=  A  MOD  32; 

3_HI  :=  3  DIV  I02f? 

B_Mln  :=  B  MOD  102*+  DIV  32; 

3_L0iM  :=  B  MOD  32? 

SUPEr.OIV  :=  A_HI  *  B_HI  *  2048  +  A_HI  *  B_MID  *  6H  +  A.HI  *  B-LQW  *  2 
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1 

7:i 

o?> 

■+11 

1 

7:i 

7o 

H12 

7:i 

94 

^15 

7:: 

119 

'+!'+ 

7:u 

152 

^+15 

i:.i 

1 

'+lb 

i:u 

3 

^+17 

1  ' 

iij 

3 

tfiS 

i:u 

0 

419 

i:i 

5 

420 

1:2 

9 

421 

1:3 

17 

422 

1:4 

17 

423 

1:4 

25 

424 

1:5 

41 

425 

1:4 

43 

426 

1:4 

54 

427 

1:4 

54 

423 

1:4 

65 

429 

1:4 

63 

430 

1:5 

68 

431 

1:6 

63 

432 

1:6 

73 

433 

1:5 

78 

434 

1:4 

78 

435 

1:4 

85 

436 

1:5 

100 

437 

1:4 

108 

438 

1:5 

115 

439 

1:6 

115 

440 

1:7 

120 

441 

i:a 

130 

442 

1:3 

150 

443 

1:7 

158 

444 

1:6 

158 

445 

1:7 

171 

446 

1:8 

171 

447 

i:s 

189 

448 

1:7 

197 

449 

115 

197 

450 

1:4 

197 

+  A_:^1l:.  *  B_HI  *  S4  +  A.MID  *  B_Mln  *    2    +    A. MID  *  B>LOW  DIV  16 

+  A_Lu.;.  *  t]_HI  *  2  +  A^LOW  *  B_MID  DIV  16  +  A_LOW  *  B.LOW  DIV  512 

+  LITTLE-DlV(A_^.'iID  *  3_L0w  *  32,A_L0^j  ♦  B.MID  *  32.A>L0W  *  3  LOW): 

Ewo  [OF  supf:i<_DivJ; 

PROCEDURE  F.SElK(*\/,.K  F:  FIB:  REC'iJM:  IfNjTEGER*); 
LABEL  1; 

VAR  3YTC, SLOCK. IJ:  INTEGER; 
BEGIN  SYSCQM'^.IORSLT  ;=  INOeRROR; 
IF  F.FISOPEN  THEN 
WITH  F.FHEADER  DO 
BEGIN 

IF  (RECNU^  <  0)  OR  NOT  FSOFTBUF  OR 

((DFKIND  =  TEXTFILE)  AND  (FRECSIZE  =  1))  THEN 
GOTO  1;  (*N0  SEEK  ALLOWED*) 
BLOCK  :=  SUPERDIV(RECNUM, FRECSIZE)  +  1; 

CRECNUM*FRECSIZE  DIV  FBLKSIZE  +  1;3 
BYTE  :=  SUPERM0D(RECIMUM, FRECSIZE)  ; 

C3YTL  :=  RECNUM*FRECSIZE  MOD  FBLKSIZE; 3 
IF  BYTE  =  0  THEN 
BEGIN 

BYTE  :=  FBLKSIZE! 
BLOCK  :=  BLOCK  -  1; 
END; 

N  :=  DLASTBLK-DFIRST8LK; 

IF  (BLOCK  >  N)  OR  ({BLOCK  =  N)  AND  (BYTE  >=  DLASTBYTE))  THEN 

BEGIN  BLOCK  :=  N;  BYTE  :=  DLASTBYTE  END; 
IF  BLOCK  <>  FNXTBLK  THEN 
BEGIN 

IF  FBUFCHNGD  THEN 

BEGIN  FBUFCHNGD  :=  FALSE;  FMODIFIED  :=  TRUE; 

UNITWRI TE(FUNIT,FBUFFER, FBLKSIZE, DFlRSTBLK+FNXTBLK-1); 
IF  lORESULT  <>  ORO(INOERROR)  THEN  GOTO  1 
END; 
IF  (BLOCK  <=  FMAX3LK)  AND  (BYTE  <>  FBLKSIZE)  THEN 

BEGIN 

UNITREAD (FUNlTiFBUFFER, FBLKSIZE 1DFIRSTBLK+BLOCK-I); 
IF  lORESULT  0  ORD(INOERROR)  THEN  GOTO  1 
END 

end; 

IF  FNXTBLK  >  FMAXBLK  THEN 
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175 
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5 
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1 

2: 

3 
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1 

2; 

4 

202 

JEGI'I    F.JlAXbLK     :=    FNXT3LK;    FMAX3YTE    :=    F'JXTBYTC    END 


tLl 


IF     (FNXTl.LK    =    Ff^lAXBLK)     AND    (FJXTBYTE    >    FfJlAXEYTE)     THEN 
FMAXBYTE     :=    FiaiGYTE; 

FEDF  :=  false;  feoln  :=  false;  freptcnt  :=  o; 

IF  FSTATE  <>  FJANDW  THEN  FSTATE  :=  FNEEDCHAR; 
FNXT3LK  :=  block;  FNXT3YTE  :=  BYTE 

ELSE  SYSCOM'^.IO-ISLT  :=  INOTOPEN; 

i: 

END  (*FSEEK*)  ; 

PROCEDURE  freadreal(*var  f:  FIB;  VAR  X:  REAL*); 

LABEL  l; 

VAR  ch:  char;  neg»xvalid:  boolean;  ipot:  integer; 

BEGIN 

WITH  F  DO 

BEGIN  X  :=  0;  NEG  :=  FALSE;  XVALID  :=  FALSE; 
IF  FSTATE  =  FNEEDCHAR  THEN  FGET(F); 

WHILE  (FWINDOW^COD  =  •  •)  AND  NOT  FEOF  DO  FGET(F); 
IF  FEOF  THEN  GOTO  1; 
CH  :=  FWINDOW^EO]; 
IF  (CH  =  •+•)  OR  <CH  =  •-♦)  THEN 

BEGIN  NEG  '=    CH  =  »-•;  FGET{F);  CH  :=  FWINDOW^COD  END; 
WHILE  (CH  IN  DIGITS)  AND  NOT  FEOF  DO 
BEGIN  XVALID  :=  TRUE; 

X  :=  X*10  +  (ORD(CH)-0RD( 'O* ) ) ; 
FGET(F);  CH  :=  FWINDOW^COD 
END; 
IF  FEOF  THEN  GOTO  1; 

IPOT  :=  -i; 

IF  CH  =  •.'  THEN 
BEGIN  IPOT  :=  0; 

REPEAT  FGET(F);  CH  !=  FWINDOW'C  0  D  i 
IF  CH  IN  DIGITS  THEN 

BEGIN  XVALID  :=  TRUE;  IPOT  :=  IPOT  +  i; 

X  :=  X  +  (ORD(CH)-ORD( 'O' ) )/PWROFTEN(IPOT) 

E^^iO 
UNTIL  FEOF  OR  NOT  (CH  IN  DIGITS); 
IF  FEOF  THEN  GOTO  1 
END; 


192 

1 

215 

2:.':< 

4-?^ 

1 

2:4 

2  I  7 

'4jm- 

j_ 

2:5 

?17 

19d 

i. 

2:o 

2^4 

^^e 

^ 

^:b 

'2i4 

497 

1 

2:b 

?.'4U 

493 

i 

2:5 

24b 

499 

i 

2:b 

253 

500 

1 

2:5 

26  9 

501 

1 

2:4 

261 

502 

1 

2:3 

2B6 

503 

2:4 

289 

501+ 

2:4 

293 

505 

2:5 

301 

50& 

2:2 

3U6 

507 

2:1 

308 

506 

2:0 

308 

509 

2:0 

328 

510 

3:d 

1 

511 

3:d 

6 

512 

3:d 

9 

513 

3:d 

27 

514 

3:0 

0 

515 

3:o 

0 

516 

3:1 

0 

517 

3:1 

15 

518 

3:1 

15 

519 

3:1 

15 

520 

3:1 

39 

521 

3:1 

46 

522 

3:1 

57 

523 

3:2 

63 

524 

3:3 

79 

525 

3;i 

96 

526 

3:2 

100 

527 

3:3 

110 

528 

3:4 

110 

529 

3:3 

123 

530 

3:3 

139 

531 

3:3 

139 

532 

3:1 

159 

IF     ((Cri    =     'L')     OR     (CH    =     'l'))     AfJD     (XVALID    OR     (IPOT    <    0))     THEN 

it.GIii 

IF    FSTATL    =    FjAuD/i    TiicfJ    FGET(F) 

ELSc  psTATt:  :-   fn^edchar; 

FK£AJl:\iT(F,lPOT)  : 
IF  FCQF  THE.J  GOTO  1; 

IF  MOT   XVALID  Them  X  :=  i;  xvalid  :=  true; 

IF    IPQT    <    0    THEN    X    ;=    X/PWR0FTEN(A3S(IP0T) ) 
ELSE    X    :=    X*PwROFTElvl(IPOT) 

END; 
if  xvalid  then 
if  neg  then  x  :=  -x 

El.se 

ELSE  SYSCOM'^.IORSLT  :=  IBADFORMAT 

1: 

END  (♦FREIADREAL*)  ; 

PROCEDURE  fwritereal(*x:real;  w,  d:  integer*); 

VAR  J,  TRUNCX,  EXPx:  INTEGER; 

normx:  real;  s:  stringc303; 

BEGIN 

{*  CHECK  W  AND  D  FOR  VALIDITY  *) 

IF  (w  <  0)  OR  (D  <  0)  THEN   BEGIN  W  :=  O;   D  .'=  0  END; 

{*  TAKE  ABS(X)*  NORMALIZE  IT  AND  CALCULATE  EXPONENT  *) 
IF  X  <  0  THEN   BEGIN  X  :=  -x;   SC13  :=  •-•  END 

ELSE  sci:  :=  •  •; 
EXPX  :=  0;  NORMX  :=  x; 

IF  X  >=  PWROFTEN(O)  THEN   (*  DIVIDE  DOWN  TO  SIZE  *) 
WHILE  NORMX  >=  PWROFTEN(l)  DO 
_BEGIN  EXPX  :=  EXPX+i;   NORMX  :=  X/PWROFTEN ( EXPX )  END 
ELSc 

IF  X  <>  0  THEN   {*  MULTIPLY  UP  TO  SIZE  *) 
REPEAT 

EXPX  :=  EXPX-i;   normx  :=  X*Pi(^ROFTEN(-EXPX) 
UNTIL  NORMX  >=  PWROFTEN(O); 

(*  ROUND  NUMBER  ACCORDING  TO  SOME  VERY  TRICKY  RULES  *) 

IF  (D=C)  OH  (D+EXPX+1  >  6)  THEN   (♦  SCIENTIFIC  NOTATION,  OR  DECIMAL  PLACES  *) 


.44 


53  3 

i 

61^ 

152 

534 

3:i 

IbO 

535 

3:3 

17? 

536 

3:3 

197 

537 

3:3 

197 

533 

3:3 

197 

539 

3:i 

197 

5^+0 

3:2 

208 

St+l 

3:2 

225 

5^2 

3:2 

225 

5f3 

3:i 

223 

5^+4 

3:2 

237 

545 

3:3 

237 

5tf6 

3:3 

215 

5*17 

3:3 

252 

5^+8 

3:2 

262 

5^+9 

3:2 

274 

550 

3:2 

274 

551 

3:i 

274 

552 

3:2 

283 

553 

3:3 

263 

55«+ 

3:3 

291 

555 

3:3 

296 

556 

3:3 

299 

557 

3:4 

304 

558 

3:5 

304 

559 

3:5 

307 

560 

3:5 

312 

561 

3:6 

317 

562 

3:5 

329 

563 

3:& 

334 

564 

3:7 

334 

565 

3:7 

339 

566 

3:& 

348 

567 

3:5 

348 

568 

3:5 

353 

569 

3:4 

361 

570 

3:3 

362 

571 

3:2 

367 

572 

3:i 

367 

573 

3:2 

369 

fJOR'IX     :=    fjOR  'IX  +    5/PWR0FTi;N(6)  (*    OVLRSPECIFIED    *) 

ELSE    ir    D+lXPX+I  >-    Q    THEW 

•vlC^Xx     :=    UQR-"X  +    5/PWR0FTEiM(  J  +  EXPX  +  1)  ; 

(*    IF    ~;  +  EXPX  +  l    <  0,     THEfv    ilU^/lBER    IS    EFFECTIVELY    0.0    *) 

(*    IF    -vE    JOST    BLEi-J    NORMALIZED    STUFF    THEfJ    FIX    IT    UP    *) 
IF    IMOR^iX    >=    PWROFTEN(l)     THEPJ 

3EGIM      EXPX    :=    EXPX  +  l;       MORMX    :=    NORV|X/PWROFTEN  ( 1 )    END; 

(*    PUT    THE    DIGITS    I^^)TO    A    STRIMG    *) 
FOR    J    :=    3    TO    8    DO 
3EGIM 

TRUNCX  :=  TRUNC(NORMX) ; 
SCj]  :=  CHR(TRUNCX+ORD{ 'O* ) ) ; 
NOR^lX  :=  (r\iORMX-TRUNCX)*PWR0FTEN(l) 
END! 

(*  PUT  NUMBER  INTO  PKQPER  FORM  *) 

IF  (0=0)  OR  (EXPX  >=  6)  THEN   (*  SCIENTIFIC  NOTATION  ♦) 

BEGIN 

SL^1   :=  SC3D; 
SC33  :=  •••5 
J  :=  8; 

IF  EXPX  <>  0  THEN 
BEGIN 

J  :=  9; 
SC9:  :=  •£•; 

IF  EXPX  <  0  THEfM 

BEGIN  J  :=  10;  sciOD  :=  •-•;  EXPX  :=  -expx  end; 

IF  EXPX  >  9  THEN 
BEGIN 

J  :=  j+i; 

scj3  :=  chr(expx  div  10  +  ord('o')); 
end; 
J  :=  j+i; 

SCJD    :=    CHR(EXPX    MOD    10    +    ORDCOM) 
LfvjO; 
SCC3    :=    CHK{ J) ; 

end 
else  (♦  some  kind  of  fixed  poi^jt  notation  *) 
if  expx  >=  0  then 


57h 

X 

3:3 

374 

57 -J 

X 

3  m 

374 

d7o 

1 

3:*+ 

5iii 

o77 

1 

3:^ 

3  92 

Dlb 

1 

3:4 

40  3 

579 

■} 

3: 3 

412 

oBO 

I 

3;y 

4x2 

531 

1 

3:3 

414 

5cJ2 

1 

3:4 

414 

563 

1 

3:4 

42  5 

564 

1 

3:4 

430 

565 

1 

3:4 

435 

5S6 

1 

3:4 

445 

587 

1 

3:4 

453 

588 

1 

3:3 

465 

589 

1 

3:i 

465 

590 

1 

3:i 

479 

591 

1 

3:o 

486 

592 

1 

3:o 

504 

593 

1 

5:d 

1 

594 

1 

5:d 

13 

595 

1 

5:o 

0 

596 

1 

5:i 

0 

597 

1 

5:i 

11 

598 

1 

5:o 

15 

599 

1 

5:o 

30 

600 

1 

5:o 

30 

601 

1 

4:d 

1 

602 

1 

4:d 

4 

603 

1 

'*:o 

4 

604 

1 

'+:d 

5 

605 

1 

'+:o 

0 

606 

1 

4:i 

0 

607 

1 

f  :2 

3 

608 

1 

'+:3 

3 

609 

1 

f  14 

6 

610 

1 

4:4 

9 

611 

1 

4:4 

48 

612 

1 

4:4 

37 

613 

1 

4:4 

114 

6m 

1 

4:3 

152 

- '"  ^  I  'J 


3-  J, 


■■«jV't.L[:FT(  SC^T,     SC2J,     uX^x  +  l); 

sr3+£:xpx:j   :=   •.'; 

-1LLCHAK(SC:JJ,  D-(5-EXPX),  •  »);  (*  3LANK  FILL  AT  END  IF  PRECISION  *) 
SCO]  :=  CHR(3+J+LXPX) ;  (*  waS  OVER-SPECIFIED  *) 

E!J  J 
ELS^ 
BEGIN 

■10\/ERIGHT(SC33«  SC3-EXPX3,  6);   {*  MAKE  ROOM  FOR  LEADING  ZEROES  *) 

SlSII  :=  '0' ; 

SC3D  :=  •.'; 

FlLLCHAR(S:4]f  -EXPX-1,  'OM;   (*  PUT  IN  LEADING  ZEROES  ♦) 

FILLCHAR(S:9-EXPX:,  D-6  +  EXPX,  •  MM*  PUT  IN  BLANKS  FOR  OVER-PRECISION*) 

SCO  J  :=  CHR(3  +  D) J 
END; 
IF  W  <  LENGTH{S)  THEN  W  :=  LENGTH(S); 
FWRITESTRING(  F.  S,  «/  ); 
END;   {*PROCEDURE  WRITE_REAL  *) 

PROCEDURE  FWRITED£C{*VAR  F:  FIB;  D:  DECMAX;  RLENG;  INTEGER*); 

VAR  s:  STRINGC38:;  i:  INTEGER; 

BEGIN 

STR(D,S) ; 

FWRITESTRING(F,S,RLEN6) 
END  (*FWRITEDEC*)  ; 

PROCEDURE  FREADDEC(*VAR  F:FIB;  VAR  O:  STUNT;  L;  INTEGER*); 
LABEL  1; 

VAR  ch:  char; 

meg.qvalid:  boolean;  dig.i:  integer; 

BEGIN 

WITH    F    DO 
3EGIIJ 

WITH  D  DO 
CASE  L  OF 

:=  0; 
:=  0; 

:=  0; 


2:  W2 

5:  W5 

e:  W8 
end; 

NEG  :=  false;  dvalid  :=  false; 


3:  w3  :=  0; 
6:  w6  :=  0; 
9:  w9  :=  0; 


t:  W4  :=  0; 
7:  w7  :=  0; 

10:  wio  :=  0 


545 


34i 


&15 

1 

3 

lb--i 

618 

4 

3 

Itt'^ 

617 

■4 

2 

ICib 

618 

1 

6 

192 

biy 

1" 

5 

198 

620 

1. 

1 

20  7 

621 

i; 

3 

222 

622 

1, 

1 

?36 

625 

i; 

5 

239 

624 

i; 

5 

21'+ 

625 

i: 

5 

?51 

626 

i; 

b 

251 

627 

i; 

6 

257 

628 

i; 

6 

281 

629 

1! 

6 

311 

630 

i; 

6 

338 

631 

i; 

6 

365 

632 

1! 

16 

392 

633 

i; 

16 

119 

631 

i: 

16 

116 

635 

i; 

16 

173 

636 

1, 

;6 

500 

637 

1, 

15 

526 

638 

i; 

;i 

533 

639 

1! 

:3 

538 

6fO 

i; 

'2 

518 

6m 

1. 

,1 

550 

612 

i; 

.0 

550 

613 

1! 

0 

576 

611 

1' 

.0 

576 

615 

1, 

;o 

0 

616 

1 

;o 

180 

617 

1 

:o 

180 

618 

0 

1 

;o 

0 

IF    FSTATl    =    f-rjEEDCHAR    THEN    FGET[F) 


•     •  )     l\HD    MOT    FEOF    DO    FGET(F) 


• )     THEN 
FGET(F) ; 
NOT    FEOF 


CH 

00 


.^jHILE  (Fwlf'JUw'^CO:  = 
IF  FEOF  THtii  GOTO  1; 

Zi^   :=  Fwi-jrowco:; 

IF  (CH  =  •+• )  OR  (CH  =  • 

JEGIN  NEG  •=  CH  =  •-' ; 
WHILE  (CH  IN  DIGITS)  AND 

3EGIi«J  DVALID  :=  TRUE; 

dis:=okl)(ch)-oro(  'O'  ) ; 
if  neg  then  dig:=-dig; 

WITH  J    DO 
CASE  L  OF 

2:w2:=io*w2+DiG; 
3:w3:=io*w3+dig; 
i:wii=io*wi+DiG; 
5;w5:=io*w5+DlG; 
6:im6:=io*w6+dig; 

7:w7:=10*W7-i-DIGi 

8:w8:=io*w8+dig; 
9:w9:=io*w9+DiG; 

10;W10:=10*W10+DIG! 

END; 

fget(f);   ch  :=  fwindow'cod 
end; 

IF  NOT-  (DVALID  OR  FEOF)  THEN  SYSCOM'*,  IQRSLT 

END; 


FWINDOW^COa    END; 


:=    IBADFORMAT 


END(*FREADOEC*)     ? 


END    C    PASCALIO    2    ; 

(♦DUfJlwiY    lEVEl    0    OUTERBLOCK*) 
BEGIN    END. 


s.incluol;  mach.type.tlxt 
,proc       decops 

5  COPYRIGHT  (C)  1978,    THE  REGENTS  OF  THE  UNIVERSITY  OF  CALIFORNIA 
'  SAN  DIEGO  CAIvPUS 


DECIMAL  OPERATORS 


<«iii««i«4i<i«<i«i«i,«tf«tti;,;;;;;;;;;; 


MP       ,EQU 

R5 

IPC      .EQU 

R^t 

BASE     .EQU 

R3 

3K       .EQU 

R2 

;.IF      SOBSXT=0 

.MACRO   SOB 

DEC 

%1                ; 

BNE 

%2 

,ENDM 

.MACRO   SXT 

BPL 

$99      ; 

MOV 

#-l,%l   ; 

8R 

$98      ; 

$99:   CLR 

%1 

S9Q: 

.ENOM 

;.ENDC 

;  note:  this  macro  version  of  sob  does 

N0T(!)  preserve  CONDITION  CODES. 


THIS  SXT  MACRO  DOES  SUPPORT  ALL 
ADDRESSING  MOOES. 
THERE  MUST  BE  A  NON-LOCAL  LABEL  BETWEEN 
ANY  Two  SXTS  IF  LSI=0 


;  TRAP  PARAMETERS 
INTOVR   .EQU     5 
DIVZER   .E3U     6 
S2L0N3   ,E3U     lb 


547 


.  JEF 


GQEC 


;dlc: 


OECIMAL  INSTRUCTION 


m\J 

{SP)+, EXTRTN 

iAO\J 

PJlPiDECMP 

mM 

IPC. DECIPC 

^OM 

BASE, DECBAS 

m\i 

BK. DECBK 

MOVB 

(SP)+»R1 

MOV 

0ECT3L(Rl) ,PC 

3IGRTN: 

MOV 

DECMPtMP 

MOV 

OECIPCIPC 

MOV 

DECBAS, Base 

MOV 

DECBK, BK 

MOV 

EXTRTN, PC 

oecmp: 

.WORD 

0 

DECIPC: 

.WORD 

0 

DECBAS: 

.WORD 

0 

DECBK; 

.WORD 

0 

extrtn: 

.WORD 

0 

3ECTBL: 

.WORD 

DAJ 

.WORD 

DAD 

.WORD 

DSB 

.WORD 

DNG 

.WORD 

DMP 

.WORD 

DDV 

.WORD 

OSTR 

.WORD 

DCV 

.WORD 

DECCMP 

.WORD 

DCVT 

.WORD 

DTNC 

;.IF  SMLI^l 

;MLi: 

^ILIL 

RS,^^ 

r^TS 

PC 

;.ELSE 

;  SOFT  MULT 

'iLi: 

;  „OFT 

MULTIPLY    IR^ 

;  SAVE  RETURN  ADDRESS 
;  SAVE  REGISTERS 


;  GRAB  INSTRUCTION  BYTE 
;  AND  GO  EXECUTE 

;  RESTORE  REGISTERS 


!  TRICKY  RETURN  TO  CALLING  ROUTINE 


LY  if  no  HARD  MULTIP^^ 
(Ri+.RS)  :=R5  X  R^  ' 


MOM 

KO.SAVQ 

.^10\/ 

Ul.SAVl 

CLR 

-(SP) 

TST 

K5 

BGT 

SI 

SEQ 

ZEROM 

I^JC 

asp 

l\IE3 

R5 

BMI 

SPECLi 

si: 

TST 

R^ 

BGT 

$2 

BE3 

ZEROM 

INC 

asP 

NE3 

R«+ 

8MI 

SPECL2 

$2: 

M0\/ 

#16.,-{SP) 

CMP 

R5»R4 

BGE 

MCLR 

M0\/ 

R5,R0 

MOV 

R4.R5 

M0\/ 

RO.R'+ 

mclr: 

CLR 

RO 

CLR 

Rl 

mmul; 

ROR 

R1 

BCC 

$1 

ADO 

RSiRl 

ADC 

RO 

CLC 

si: 

ROR 

RO 

ROR 

Rl 

BCC 

CYC 

SIS 

#100000»rO 

:yc: 

DEC 

asp 

BST 

MMUL 

TST 

(SP)  + 

MOV 

R0«R5 

MOV 

R1.R1 

ROR 

(SP)  + 

BCC 

OUTM 

COM 

Rf 

f«IE(5 

R5 

SAVE  REGISTERS 

SlGrg  STORAGE 
CHECK  MULTIPLICAND 
SKIP  FOLLOWING  IF  + 
ANSWER  IS  ZERO 
REMEMSER  NEGATIVE 

;  SPECIAL   HANDLING  FOR 
;  TEST  MULTIPLIER 


-32768 


SET  UP  ITERATION  COUNT 

MAKE  SURE 

MULTIPLIER 

IS 

SMALLER 


;  CLEAR  PRODUCT 

GET  MULTIPLIER  BIT 

=  0? 
NO,  ADD  IN  MULTIPLICAND 


;  ROTATE  PRODUCT 


GET  RID  OF  COUNTER 

PUT  RESULT  IN  OUTPUT  REGISTERS 

NOTE  REVERSAL  OF  REGISTERS 

DETERMINE  SIGN 

OF  PRODUCT 


549 


JJ( 


iCS 

£1 

INC 

K4 

ti: 

3rl 

OUTM 

iPECLS; 

MD\/ 

R5.Rtf 

SPECLi: 

CLR 

R5 

ASf? 

(SP)  + 

3NE 

$1 

NES 

R4 

4.1: 

ASR 

R4 

3CC 

OUTM 

ROR 

R5 

TST 

Rtf 

BPL 

OUTM 

lUC 

R^' 

outm: 

MOV 

SAVO.RO 

MOV 

SAV1,R1 

RTS 

PC 

zerom: 

CLR 

R'* 

CLR 

R5 

TST 

(SP)  + 

BR 

OUTM 

sAvo: 

.WORD 

SAvi: 

.wORD 

;.ENDC 

;  Rl  WAS  -32768 

;  ELSE  Rb  WAS  -32766 

;  WAS  R5  NEGATLD  ALREADY? 

;  YES 

;  NO   NEGATE  NOW 

;  DIVIDE  3Y  2 


FIX  FOR  NEGATIVE 
ODD  NUMBERS 

RESTORE  REGISTERS 


oaj: 


;  DECIMAL  ADJUST 


XPAND 


shrink: 
jLoop: 


MOVB 
SJ3 

BEQ 
3LT 
TST 
SXT 

MOV 

SOB 

BR 

NE3 

TST 

BEa 

I^JC 

BEQ 


(SP)+iRO 
(SP)+.RO 
DAJDNE 
SHRINK 

asP 

Rl 

R1.-{SP) 

RO, XPAND 

OAJDNE 

RO 

(SP) 

OPOS 

{SP)  + 

DNEG 


;  GET  DESIRED  LENGTH 

;  TOSS  OPERAND  LEN;  RO  =  DIFF 


;  SIGN  EXTENSION 


;'jnlg:   tst 

3Pi. 
sod 
3R 
DPOS:    TST 
TST 

S03 

■jajdne:  j^p 


dc\/t: 


DTNC: 


ong: 


MOV 

JMP 

MQy/ 

BR 


(SP) 

HOLE 
RO.DLOOP 

(SP)  + 
(SP) 

HOLE 
ROiDLOOP 

aif*3lSRTN 

#1»-(SP) 

dl«8IGRTN 

ttl»-(SP) 
DAJ 


;    DECIMAL    NEGATE 
MOV  SP,R1 

JSR  PC»OODNG 

J^P  aj*BIGRTN 


;  OVERFLOI.-J 

;  OVFL  OCCURhlU 

;  KNOCK  SP 

;  EXIT  DECOPs 

;  PUSH  LENGTH  WORD  OF  1 

;  PUSH  DESIRED  LENGTH  OF  1 


;  EXIT  DECOPS 


DODNG:   ;  NEGATE  SUBROUTINE..  BK  iS  DESTROYED 


$1 


$2; 


MOV 

(R1),BK 

ASL 

OK 

ADD 

RXtBK 

MOV 

(R1),R1 

TST 

(3K)  + 

SEC 

BCC 

CRYCLR 

COM 

-(BK) 

ADO 

«1.  (BK) 

SOB 

Rl.Sl 

3VC 

DNGEND 

TST 

-(3K) 

TST 

-(SP) 

MOV 

SP,R1 

MOV 

2(R1),( 

CMP 

Rl.BK 

.LCf 

S2 

Rl  POINTS  TO  LENGTH  UPON  ENTRY 

8K  POINTS  TO  LSB 
NO^  Rl  HAS  LENGTH 


INSERT  EXTRA  WORD 


(Rl)  + 


351 


vJL> 


TST 

2(3K) 

sxr 

(bK) 

oR 

DNSEInIU 

cryclr; 

co^^ 

-(BK) 

S03 

Rl. CRYCLR 

jngend: 

MD\i 

bKtiU 

TST 

-(iU) 

RTS 

PC 

jsb: 

;  DECIMAL  SUBTRACT 

mM 

SPtSUBFLAG 

JSR 

PCiADOSUB 

BR 

DCH 

DAO: 

;  DECIMAL  ADD 

CLR 

SUBFLAG 

JSR 

PC. ADDSUB 

BR 

DCH 

addsub: 

MOM 

{SP)+,ASrET 

m\j 

(SP)»RO 

ASL 

RO 

ADD 

SP.RO 

TST 

(R0)  + 

CMP 

aROtasp 

BE3 

GOADO 

JSR 

PC.OECADj 

soadd: 

MOV 

(RO) ,3K 

ASL 

(RO) 

M0\/ 

RO.Rl 

ADD 

(RO) ,R0 

TST 

SJBFLAG 

8E3 

ADLOOP 

3R 

SUBBER 

sbloop: 

SBC 

-(RO) 

BCC 

$1 

SUB 

-(Rl) » (Ro) 

SEC 

BR 

SUB2 

Si: 

=^VC 

SJBBER 

SJ3 

-(Rl) , (Ro) 

;  RESTORE  Rl  TO  ORIG.  VALUE 


;  (MOfJZERG  VALUE  INDICATES  SUBTRACT 


;  ZERO  INDICATOR  FOR  ADD 


SAVE  RETURN  ADOR 
GET  LENGTH 
FOR  BYTES 

POINT  RO  TO  2ND  OP  LEN 

COMPARE  LENGTHS 

EQUAL  -  O.K. 

GO  MAKE  EQUAL 

BK  HAS  LENGTH  (WORDS) 

RO  POINTS  TO  LENGTH  (BYTES) 

Rl  POINTS  TO  OP  1  LSB  +  1  WORD 

RO  POINTS  TO  OP  2  LSB 

ADD  OR  SUBTRACT? 


;  CARRY 

:  IF  HERE.  MUST  PASS  ON  CARRY 

;  KEEP  TRACK  OF  OVERFLOW 


3R 

SJ33 

3UB3ER: 

SJ3 

-(Rl) , (Ro) 

3VC 

SUB2 

SUB3: 

S33 

BKiSBLOOp 

3CC 

NWORD 

3R 

ZWORD 

SU32: 

SOB 

BK.SBLOOP 

3R 

iJOXTRA 

DADi: 

ADC 

-(RO) 

BCC 

$1 

^0\J 

-(R1),{R0) 

SOB 

'  BKtDADl 

BR 

NOXTRA 

si: 

BVC 

ADLOOP 

ADD 

-(Rl) i(R0) 

BH 

OLOOP 

aduoop: 

ADD 

-{R1),(R0) 

BVS 

OLOOP 

SOB 

BKfDADl 

BR 

NOXTRA 

oloop: 

SOB 

BKtDADl 

BCC 

ZWORD 

nword: 

MOV 

#-li-(RO) 

BR 

PUTLEN 

zword: 

CLR 

-(RO) 

putlen: 

ADD 

«1»(SP) 

noxtra: 

m\i 

(SP),-(Ro) 

MO\J 

RO.SP 

JMP 

a(PC)+ 

ASRET: 

.WORD 

SUBFLAG; 

[.WORD 

PERFORM  SUbTKACTION 
SEPARATE  LOOP-END  FoR  OVFL 


;  FINISHED  SUBTRACTION  W/O  OVERFLOW 

;  ADD  CARRY  BIT  IN 

J  IF  ADDEND  WAS  -1  THEN  RESULT  IS  0  WITH 

;  CARRY.  SO  JUST  MOVE  2ND  ADDEND 

;  AND  KEEP  CARRY. 

;  IF  OVERFLOW  THEN 

}  KEEP  TRACK  OF  IT 

;  MOVE  Rl  AND  ADD 

;  SEPARATE  LOOP-END  FOR  OVFL 

5  FOR  EACH  WORD  PAIR 

;  EXTRA  WORD  NOT  NEEDED 

;  RESULT  POSITIVE 

;  RESULT  NEGATIVE 

;  PUT  SIGN  EXTENSION  IN 

;  INCREASE  LENGTH  BY  ONE 

;  PUT  LENGTH  IN  RESULT 

;  ADJUST  SP 

;  RETURN 

;  ADO/SUBTRACT  INDICATOR 


DECADJ:  ;  THIS  ROUTINE  MaKES  2  DECIMALS. 

;  (TOS)  AND  (TOS-1).  OF  EQUAL  LENGTH. 

;  (SP)=UPPER  LENGTH  (WORDS) 

;  (R0)=LOWER  LENGTH  (WORDS) 

;  SAME  CONDITIONS  ON  OUTpjT 

;  REGISTERS  BK.Rl  ARE  DESTROYED 

MOV      (SP)+.DReT       ;  SAVE  RETURN  ADDR 

MOV      3ASE.3ASSAV      ;  SAVE  REG 

MOV    asp.Ri 
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SJd 

^?.ROt^l 

;  Rl  =  LEf«l  OIFF  (WORDS)  <>  0 

ASL 

Rl 

:  CHANGE  TO  BYTES 

iLT 

TOP 

,  50  EXPAND  TOP  DECIMAL 

MOM 

SP,3K 

•  SAVE  Old  TOS 

SU3 

RltSP 

•  MAKE  ROOM  FOR  EXPANSION 

M0\/ 

SPtBASE 

POINTS  TO  NEW  TOS 

SHIFTi: 

,»J10\/ 

(BK)+t (BaSE)+ 

SHIFT  WORDS 

Ci'^P 

3K,R0 

UNTIL  ENTIRE  TOP 

3LT 

SHIFTI 

OPERAND  SHIFTED 

•■lO^ 

BASE.'^O 

POINT  RO  AT  BOTTOM  LENGTH 

MOV 

(SP) 1 (RO) 

PUT  IN  BOTTOM  LENGTH 

BR 

FILL 

top: 

f\IE3 

Kl 

MOV 

SPtBK 

SAVE  OLD  TOS 

SJ3 

R1,SP 

UPDATE  SP 

MOV 

(RO),(SP) 

SET  LENGTHS  EQUAL 

fill: 

TST 

2(BK) 

FILL  WITH  ZEROES  OR  ONES? 

SXT 

BASE 

SIGN  EXTENSION 

ASR 

Rl 

BACK  TO  WORDS 

$i: 

MOV 

BASE, (BK) 

MOVE  FILLER 

TST 

-(BK) 

DECREMENT  BY  2 

S03 

Rl»$l 

UNTIL  FULL 

MOV 

BASSAVfBASE 

RESTORE  REG 

JMP 

3(PC)+ 

RETURN 

dret: 

.WORD 

3ASSAV: 

.WORD 

dch: 

;  CHECK 

DECIMAL  LENGTH 

CMP 

ttlO.,{SP) 

CHECK  LENGTH   (WORST  CASE 

3LT 

DOVR 

OVERFLOW  IF  TOO  LONG 

JMP 

a«BIGRTN 

dovr: 

TRAP 

INTOVR 

OVERLFOW 

(FUTURE) 


QMP:     ;  DECIMAL  MULTIPLY 
JSR      PCfOMUL 
3R       DCH 


;  CHECK  FINAL  LENGTH  AND  LEAVE 


IPCSAV:  .WORD 


■"Mul: 


$1 


zprod; 


41 : 


dget: 


SI 


jStTUP; 


■10^      (SP)  +  ,^)MpRET 

^D\J  IPCIPCSAV 

CLR      iJEGl 

f>^0\/      (SP)  +  ,RO 

TST      (SP) 

6PL      $1 

M0\/      ROf-(SP) 

^"J^      SPtRl 

JSR  PC.DOUNG 

If^C  NEGl 

Ma\/    {sP)  +  fRO 

TST      (SP) 

8N£  DGET 

TST      (SP)+ 

S03  ROtSl 

;  IF  HERE  THEN  PRODUC 

;  FILL  MULTIPLICAND  W 

M0\/  (SP),R0 

"■lOV  SPfRl 

TST  (Rl)+ 

CLR  (R1)+ 

SOB  R0»$1 

JMP  OMPEND 

M0\/  R0,R1 

ASL  Rl 

ADD  SPfRl 

M0\/  (R1)  +  ,R2 

TST  (Rl) 

3PL  $1 

TST  -(Rl) 

JSR  PC»DODNG 

DEC  NEGl 

MOV  (R1)+,R2 

TST  (Rl) 

BNE  DSETUP 

TST  (Rl)+ 

S03  R2f$l 

ASL  RO 

ADD  RO.SP 

J'AP  DMPErjD 

^■^OU  SP,R3 


;  SAVE  RETURij  ADDR 

:  R0-R5  USEJ 

;  NEGATIVE  REMEMBERER 

;  POP  OFF  MULTIPLIER  LENGTil 

;  CHECK  FOR  NEG  SIGN 

;  SETUP  FOR  CALL 

;  ABS  VALUE  RETURNED 

;  REMEMBER 

;  REPEAT  OF  ABOVE  SETUP 

;  GET  RID  OF  LEADING  ZEROES 

;  INCREMENT  TO  NEXT  LEADING  DIGIT 

T  Is  ZERO 

ITH  ZEROES  AND  EXIT 
;  PUT  LENGTH  IN  RO 

;  INCREMENT  Rl  TO  MSB 

;  CLEAR  ALL  ^OHDS 

;  HERE  GET  RJD  OF  MULTIPLICAND  ZEROES 

;  FIRST  LOCATE  LENGTH 

;  AND  PUT  IN  Rl 

;  NOW  R2  HAS  LENGTH  AND  Rl  POINTS  TO  MSB 

;  CHECK  NEG, 

J  DECREMENT  TO  POINT  TO  LENGTH 

;  FOR  CALL  TO  ABS  VALUE  GETTER 

;  IF  BOTH  OPS  NEG  THEN  ZERO  RESULTS 

;  REPEAT  OF  ABOVE  STMT 

;  SAME  LEADING  ZERO  PROCESSING 


OOPS  IT  WAS  ALL  ZEROES 
ADJUST  SP  AND  LEAVE 

SP  POINTS  TO  M'PLIEF  'SB. .NEEDED  LATER 
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.-0\/ 

i<2.Rf 

AOO 

R0.R4 

MOV 

i^^tLEJSAv 

£i; 

CLR 

-(SP) 

S3J 

U^+f  $1 

MOM 

R2»L2SAV 

CLK 

POSSAV 

'AO\J 

ROt COUNT 

MO\J 

SP,RO 

3R 

DMULT 

hiloop: 

^0\l 

R^, COUNT 

IAQ\J 

POSSAViRo 

TST 

(R0)  + 

MOV 

R0«POSSAv 

ADD 

SP,RO 

MOV 

L2SAV,R2 

SUB 

R2,R1 

SUB 

R2fRl 

TST 

(R3)  + 

dmult: 

MOV 

(R3) fRf 

MOV 

(R1),R5 

TST 

Rt+ 

BPL 

$1 

TST 

R5 

BPL 

$2 

AOO 

RS^R^ 

BR 

$3 

$i: 

CLR 

ADJSAV 

TST 

R5 

BPL 

DOOIT 

3R 

$3 

*2: 

MOV 

RSiR'* 

S3: 

MOV 

R4»ADJSA\/ 

MOV 

{R3) ,R4 

DOQIT: 

MOV 

(R1)+,R5 

JSR 

PCfMLI 

AOO 

ADJSAVfR£+ 

AOO 

R^t.  (R0)  + 

3CC 

SI 

OEC 

RO 

DEC 

RO 

CONSTRUCT  PRODUCT  LLN3TH  NOW 
EQUALS  SUM  01"  OPR.  LENGTHS 

CLEARING  AREA  FOR  PROOUCT  ON  TOP  OF  STACK 

MULTIPLICAND  LENGTH 

P0SSAV=LEADING  CURRENT  POSITION  IN  PRODUCT 

MULTIPLIER  LENGTH 

RO  WILL  BE  CURRENT  PRODUCT  WORD 

RE-SAVE  COUNT  OF  M»PLIER  WORDS 
INCREMENT  TO  NEXT  PRODUCT  POSITION 


;  SET  UP  RO  TO  POINT  TO  IT 
;  REINIT  LOOP  COUNT 

BACK  TO  BEGINNING  OF  M'CAND 

KICK  M'PLIER  INDEX 

MULTIPLIER  WORD 

M'CAND  WORD 

PERFORM  TWO'S  COMPLEMENT  ADJUSTMENTS  FIRST 


;  BOTH  NEG.  -  IGNORE  OVERFLOW  HERE 

;  ENSURE  CLEAR  FOR  NO  ADJUSTMENT 

BOTH  POS. 

R5  NEG,.  ADD  R*+ 

R^    NEG.t  ADD  R3 

ADJUSTMENT  FOR  Hi  ORDER  HALF  OF  PRODUCT 


TIMES  M'CAND  WORD 
STICK  IN  ADJUSTMENT 
HI-ORDER  PROD 

RE-ALIGN  RO 


-  IGNORE  CARRY 


^lOV  NNf-J,R5 

i3:  CLR  -(SP) 

S05  R3.$3 

m\J  AADD,Ri+ 

fAO\J  MMMtRS 

TST  (Rtf)  + 

St:  M0\/  -(R'f),-(sP) 

SOB  R5»$f 


;  MAKE  N  WORDS  OF  ZEROS  FOR  B. 


MOVE  M  WORDS  FROM  AADD  TO  TOP  OF  STACK 


.INCLUDE   DECOP.B.TEXT 


MOV  r\JNN»R5 

SUB  MMM»R5 

BEQ  $6 

BPL  $5 

JMP  BOMB 

$5:      MOV  3SIGNt-(sP) 

SOB  R5f$5 

S6:      MOV  CADD,R«t 

MOV  AADD.RS 

CMP  (RH)+,(R5)+ 

MOV  NNN«R3 

*7:      MOV  -(Rtf).-(R5) 

CLR  (Rt) 

SOB  R3»$7 

MOV  TW0N,R3 

ASL  R3 

MOV  R3,LENG 

TST  -(R3) 

MOV  AADDtAWS 

SUB  R3.AWS 

MOV  BADD.BWS 

SUB  R3.BWS 

MOV  AADD,R2 

MOV  TW0N,R3 

JSR  PCLASL 

MOV  AAD0,R2 

MOV  TW0N,R3 

JSP?-'  PCLASL 


}  ADJUST  RH  AND  R5 

;  MOVE  A  AND  CLEAR  C. 

;  SAVE  LONG  LENGTH  IN  BYTES 

;  SAVE  ADDRESS  OF  SIGN  WORD  OF  A, 

;  SAVE  ADDRESS  OF  SIGN  WORD  OF  B. 


;  ADJUST  A  FOR  PROPER/  'VISION. 
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DDVB: 


si: 

$2: 


$i: 


sxtbrk: 


DIVISION  JloImS  here. 
ASIGNiBSiGN 
£1 
PCLADDAb 

$2 
PCfLSuBAB 

PC.LSLC 

R5 
R5 
R5 
-{R5) 

;   MAIN  DIVISION  LOOP  BE 
JSR      PCtLSRB 
TST      SAWS 
SXT      RO 

TST  aews 

SXT  Rl 

CVIP  ROiRl 

BEQ  $2 

JSR  PCLADDAb 

CLC 


3£o) 
JSR 

se: 
an 

JSR 

CLC 
JSR 
M3V 
ASL 
ASL 
ASL 
TST 


3R 

$3 

$2: 

JSR 
SEC 

PCtLSUBAB 

$3: 

JSR 

PC.LSLC 

SOB 

R5.MDL 

eomdl: 

;   END 
SEC 

OF  MAIN  DIVISION 

JSR 

PC.LSLC 

TST 

cDAWS 

SXT 

R5 

Ci'^^P 

R5.ASIGN 

BEQ 

$6 

TST 

ASIGN 

3Nt 

$3 

SIGN  OF  A  IS  NOT  SAME  AS  SIGN  OF  3 
SO  A:=A+B  AND  ANSWER  WILL  SE  NEGATIVE 

SIGN  OF  A  SAME  AS  SIGN  OF  3  SO  a:=A-B 
AND  ANSWER  WILL  BE  POSITIVE. 
SHIFT  CARRY  LEFT  INTO  LSBIT  OF  C 
ON  A  16  BIT  MACHINE  THE  NUMBER  OF  REPITITIONS 
IS  <NUMBER  OF  WORDS  IN  A>  X 
<16  BITS  PER  WORD>  -  2 

R5  CONTAINS  THE  NUMBER  OF  REPITITIONS  FOR 
THE  MAIN  DIVISION  LOOP. 
INS  HERE. 
SHIFT  TRIAL  DIVISOR  LEFT, 


IF  EQUAL  THEN  PARTIAL  REMAINDER  AND  TRIAL 
DIVISOR  HAVE  THE  SAME  SIGN. 
SIGN  OF  PR  AND  TD  DIFFERENT 

SO  pr:=pr+td  (ai=a+3) 

AND  SHIFT  A  ZERO  INTO  LSBIT  OF  QUOTIENT 

c:=(c$2)+o 

SIGN  OF  PR  AND  TD  SAME  SO  PR:=PR-TD   (A:=A-B) 
AND  SHIFT  A  ONE  INTO  LSBIT  OF  Q.   C:=<C$2)+1 
ACTUALLY  DO  THE  SHIFT  ON  C. 


LOOP 


SHIFT  A  ONE  INTO  LSBIT  OF  C. 


IF  SIGN  OF  A  EQUALS  SIGN  OF  REMAINDER  THEN 

BRANCH  TO  $6  ELSE 

IF  A<0  THEN 

ANSWER    CORRECT    ANQ^aiLONE 


tW"^ 


>6; 


$6: 

$7: 
$3: 

LEAVE: 

30MB: 


LSLC: 


lasl: 

3SLC: 

ti: 

eosl: 

LSRS: 


TST 

3Eo) 

3R 

TST 

BEQ 

TST 

8EQ 

BR 

MOV 

MOV 

TST 

SEC 

ADC 

BCC 

SOB 

BR 

BIC 

MOV 

TST 

JMP 

MOV 
CLR 
MOV 

BR 

MOV 
MOV 
ROL 
DEC 
BEO 
BR 

TST 

• 

ROL 
SOB 
RTS 

MOV 
MO\f 


[iSIGN 

$7 

S8 

ASIGlJ 

$3 

3SIGiJ 

$7 

$8 

NNN.HO 

CAD0»R1 

(Rl)  + 

"(Rl) 

$3 

R0f$2 

$3 

ttl.aCADD 

AADD.SP 

(SP)  + 

a«8IGRTfM 

CADDtSP 

(SP) 

«1.-(SP) 

LEAVE 


;  OTHERWISE 

;  IF  B>=0  THEN  S7  ELSE 

;  IF  3<0  THEN  $8 

;  IF  A>=0  THEN  DONE  OTHERWISE 

;  IF  B>=0  THEN  $7  ELSE 

;  IF  B<0  THEN  S8, 

;  DO  LONG  ADD   C=C+1 

;   PREFORMED  ONLY  WHEN  3>=0 


;  EARLY  TERMINATION  OF  LONG  ADDITION 

J  END  OF  ADDITION     C=C+1 

J  IF  B<0  THEN  CLEAR  LSBIT  OF  C  AND  FINISHED. 

;  ADJUST  STACK  POINTER 

;  AND  LEAVE, 
;  EXIT  DECOPS 

J  THIS  IS  THE  ERROR   CASE.   IT  CURRENTLY 

}  SETS  THE  ANSWER  TO  ZERO.   IN  THE  FUTURE  IT 

;  WILL  GENERATE  AN  ERROR  TRAP. 


CADD,R2 

NNN»R3 

(R2) 

R3 

EOSL 

BSLC 

;  LONG  ARITHMETIC  SHIFT  LEFT 
{R2)-»- 


-(R2) 
R3f$l 

PC 

3WS,R2 
T^ONf R3 


;RETURN  FROM  ARITHMETIC  SHIFT  LEFT 
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lasr: 


SI 


ticsR: 


laddab; 


LADD 


$2! 


S3: 

eoladd; 


lsubab: 


lsub: 
$i: 


S2 


S3; 

eiolsub; 


DEC 
3£ol 
ROR 
SOS 
RTS 

CAP 

add 
m\i 

DEC 
8E3 
MOV 
BCC 
ADC 
SOB 
SOB 


;   END 
RTS 

MOV 

MOV 

MOV 

CMP 

SU3 

MOV 

DEC 

BE3 

MOV 

BCC 

SBC 

303 

SOB 

;   END 

RTS 

;  THIS 


(R2)  + 

K3 

EDSR 

(K2)  + 

R3t$l 

PC 

AADDiRO 
BADD.nl 
TW0N.R2 
(RO)+,(Rl)+ 
-(Rl) ,-(rO) 
R2fR3 
R3 
$3 

RO.RH 
$3 

-<R*f) 
R3.$2 
R2.$l 
OF  LONG  ADD. 
PC 


AADD,RO  ; 

BADD.Rl 

TwlOI\J,R2 

(RO)+,(Rl)+  ; 

-(Rl) ,-(rO) 

R2»R3 

R3 

$3 

R0»R4 

$3 

-(R'+) 

R3.$2 

R2t$l 
OF  LONG  SUBTRACT. 

PC 
IS  THE   End  OF  DDV, 


LOHG  ARITHr/EflC  SHIFT  RIGHT 


;  RETURN  FROM  ARITHMETIC  SHIFT  RIGHT 


A  =  A  +  B 


ADJUST  ADDRESSES 


A=A-B 


ADJUST  ADDRESSES 


;  FOLLOWING  ARE  STATIC  STORAGE  IaIORDS  OF  DDV. 


■j)mm: 

..-iORD 

■>jnn: 

.wORD 

twon: 

♦  WORD 

leng: 

.WORD 

Aws: 

.WORD 

3ws: 

.WORD 

asign: 

.WORD 

3SIGN: 

.WORD 

'\add: 

•  WORD 

badd: 

.WORD 

cadd: 

.WORD 

DVIPC: 

.WORD 

deccmp: 

!  COMPARE  DECIMALS 

MOV 

(SP)+,RO 

ASL 

RO 

MOV 

SBROPS(R0)»$5 

MOV 

UBROPS{R0>»$2 

MOV 

(SP)iRO 

ASL 

RO 

ADO 

SPtRO 

TST 

(R0)  + 

CMP 

aROtasp 

BEQ 

S8 

JSR 

PC«DECADj 

$8: 

MOV 

(RO) .BASE 

ASL 

BASE 

ADD 

RO.BASE 

TST 

(R0)  + 

MOV 

(SP)+,8K 

CMP 

(RO)+»(Sp)+ 

BNE 

$5 

BR 

$7 

$i: 

CMP 

(R0)+, {Sp)+ 

SHE 

$2 

$7: 

303 

8K,$1 

$2: 

NOP 

BR 

$n 

3R 

S6 

$5: 

NOP 

;  GET  COMPARISON  TYPE  INDEX 

?  PUT  IN  SIGNED  CMP  OPR 

;  PUT  IN  UNSIGNED  OPR 

;  PROCESSING  TO  POINT  RO  AT  LEFT  OPR  LENGTH 


;  RO  NOW  POINTS  TO  LENGTH 
J  COMPARE  LENGTHS 

I  MAKE  LENGTHS  EQUAL 

J  BASE  WILL  HOLD  ADDR  OF  RESULT 

;  BASE  NOW  POINTS  TO  RESULT 
RO  POINTS  TO  LEFT  OPR  MSB 

SP  POINTS  TO  RIGHT  OPR  MSB;  BK  HAS  LENGTH 
COMPARE  SIGN  WORDS 


;  COMPARE  UNSIGNED  WORDS 
;  ANY  NEQ  STOPS  LOOP 

;  UNSIGNED  COMPARE  OP  GOES  HERE 


;  SIGNED  CMP  OP  HERE 
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Jb 


3'^ 

$4 

sb: 

MO\J 

rtl. (BASE) 

S3  ! 

^OM 

3ASE,SP 

Ji^P 

a#8IGKTN 

$4: 

CLR 

(BASE) 

3R 

$3 

i  EXIT  DECOPS 


ostr: 


$i: 
s2: 


S3: 


INITIALIZE 

SIGNIFICANCE  FLAG 

SHIFT  COUNTER 

FOR  DODNG  AND  LATER  PROCESSING 

NEGATIVE? 


DECIMAL  TO  STRING  CONVERT 

REGISTER  assignments: 

IPC  =  POWER  OF  TEN  INDEX 

BASE  =  POINTER  TO  STRING 

MP  =  POINTER  TO  LAST  CHAR  IN  STRING 

BK  =  DECIMAL  LENGTH 

MOV      (SP)+»SLeNG 

MOV      {SP)+,BASE 

MOV      BASEtMP 

INC      MP 

Move     #1,(BASE) 

MOVB     »"0"»(MP) 

CLR      SIGNIF 

CLR     ZCOUNT 

MOV     SPiRl 

TST     2(SP) 

BGE      $1 

JSR      PCiDODNG 

MOVB     #••-",  (MP) 

INCB     (BASE) 

INC      MP 

MOVB     #"0"»(MP) 

MOV      (SP),BK 

TST      (Rl)+ 

TST      (Rl)+ 

BNE      $3 

SOB      BK.$2 

MOV      Rl.SP 

3R       STRENO 

TST      -(Rl) 
BGE      $4 
TST      -(Rl) 
INC      3K 


;  MAKE  POSITIVE 

;  INSERT  MINUS  SIGN 


INCREMENT  TO  SIGN  WORD 

GET  RID  OF  LEADING  ZEROES 

-(Rl)  WAS  NONZERO 

BK  KEEPS  TRACK  OF  LENGTH 

IF  HERE*  NUMBER  WAS  ZERO 

SO  POP  DECIMAL  AND  LEAVE 

CHECK  SIGN  BIT  -  SHOULD  BE  POSITIVE 

RESTORE  A  WORD  OF  ZEROES 


CI4 


CENO; 


'■'!G^      R1,SP 

;  noa  choose  appropriate 

C^P  3Kt#2 

33T      CI 
?.^a\/      rtP0T2,IPc 
3R       CEND 

3GT      C3 

MOV      **POTif,lPc 

8R       CEND 

MOV      »P0T8.lPc 

;  HERE  COMPARE  INPUT  TO 

CMP      (SP)t(lPC) 

3GT      $1 

BLT  DLESS 

CMP  2{SP),2(IPC) 

BLO  DLESS 

;  ELSE  ASSUME  DECIMAL  GR 

Si:      JSR  PC.CLOAD 

MOV  SP,SUBFLaG 

JSR  PCiADDSUb 

;  TEST  FOR  ZERO  OR  LESS 

TST  2(SP) 

3LT  RESTOR 

IMCB  (MP) 

INC  SIGNIF 

MOV  (SP),R1 

TST  (SP)+ 

$2:      TST  (SP) 

BLT  $3 

BNE  $4 

TST  (SP)+ 

SOB  RliS2 

BR  TRAIL 

S3:      CLR  -(SP) 

INC  Rl 

St:      MOV  R1,-(SP) 

3R  CEND 

RESTOR:  JSR  PCiCLOAD 

CLfV  SUBFLAG  ; 


;  PUT  ON  LEinIGTH  TO  MAKE 

;  A  COMPLETE  (SHORTER)  DECIMAL 

POWER  OF  TEN 
;  DECIMAL  LEN  <=  2  ? 

;  YES*  POINT  IPC  TO  RIGHT  P.O.T. 

;  DECIMAL  LEN  <=  «+  ? 


POT 
COMPARE  LENGTHS 
DECIMAL  LONGLR  (GREATER) 
DECIMAL  SHORTER  (SMALLER) 
COMPARE  MSB  WORDS 
DECIMAL  SMALLER 
EATER  OR  EQUAL  FOR  NOW 


PUT  POT  ON  STACK 
SET  NONZERO  FLAG 
AND  SUBTRACT  (NOTE 


NO  REG  SAVE) 


OOPS  DECIMAL  WAS  SMALLER 

ALSO  INCREMENT  STRING  HERE 

AND  SET  FLAG 

LENGTH 

INCREMENT 

LOOP  TO  TEST  FOR  ZERO 

RESULT  AND  ALSO 

SHORTEN  DECIMAL 

BY  REMOVING  LEADING  ZEROES 

DIFFERENCE  ZERO  -  CONVERSION  COMPLETE 

HERE,  RETAIN  EXTRA  LEADING 

ZEROES  FOR  POSITIVE  SIGN 

LENGTH 

DO  IT  AGAIN 

INDICATES  ADD 


O  L)  n 


/LESS: 


TRAIL; 


Si: 


strend: 


$i: 


JSR 
'AQ\I 

AO\J 

■10  M 

m\J 

JSR 

m\i 

■AO\J 

INC 

TST 

BEQ 

IfMCB 

IMC 

MO\/B 

3R 

;    HERE, 

MOV 

SUB 

BEQ 

INCB 

IMC 

MO\/B 

SOB 

CMPB 

BLOS 

TRAP 

JVIP 


PCADDSUb 

MPiCHSAV 

BASE.BAStlSV 

t*10.,-(Sp) 

tfl.-(SP) 

PC, DMUL 

CHSAV.MP 

BASESV.BaSE 

ZCOUNT 

SIGNIF 

CEND 

(BASE) 

MP 

»"0", (MP) 

CEND 

ADD  TRAILING 

-{IPC),RO 

ZCOUNT, RO 

STREND 

(BASE) 

MP 

#"0",(MP) 

R0,$1 

aBASE,SLENG 

$1 

S2L0NG 

a#BIGRTN 


;  FALLS  INTO  DLESS 

;  SAVE  REGS  EXCEPT  IPC 

;  PUSH  D  10  ON  STACK 

;  AND    WIULTIPLY 

;  KESTORE 

;  COUNT  THE  SHIFT 

;  DON'T  PUT  OUT  A  NON-SIGNIF.  ZERO 


;  REPEAT  PROCESS  FOR  NEXT  DIGIT 
BLANKS 

;  NO.  OF  ZEROES  IN  POT 

;  THESE  DIGITS  ACCOUNTED  FOR 

;  IF  NO  TRAILING  ZEROES 


;  CHECK  STRING  LENGTH 


?  EXIT  DECOPS 


CLOAD:   ;  LOAD  A  POWER  OF  TEN 

MOM  (SP)+,$3 

mM  (IPC),RO 

INC  RO 

MOV  IPCRl 

ADD  RCRl 

ADD  RO,Ri 

Si;      MOV  -(R1),-(SP) 

SOB  R0,$1 

TST  2(SP) 

BGE  $2 

MOU  (SP),-(Sp) 


SAVE  RETURN  ADDR 

LENGTH 

INCLUDE  LENGTH  IN  TRANSFER 


;  NOW  Rl  POINTS  TO  LSB  +   2 


;  IF  SIGN  BIT  USED 
;  THEN  MAKE  POSITIVE 


ZLR 

2(SP) 

lUZ 

(SP) 

.b2: 

J  ••■-IP 

n](PC)  + 

1.3: 

CHSAV: 

.WORD 

SASESV; 

.ti/ORD 

3LENG: 

..■jOKD 

signif: 

.WORD 

zcount: 

•  L'jORD 

P0T2 

.Eo!U 

*  +  2 

.WORD 

3* 

.WORD 

2 

.WORD 

035632 

.WORD 

li+SOOC 

POTH 

.EQU 

*  +  2 

.WORD 

19. 

.WORD 

^ 

.WORD 

105307 

.WORD 

02140*+ 

.WORD 

104750 

.WORD 

000000 

P0T8 

.EQU 

*  +  2 

;  NOTE 

ANY  NUMBERS  GREATER 

5  ARE  MISREPRESENTED 

.WORD 

38. 

.WORD 

3. 

.WORD 

0H5473 

.WORD 

046250 

.WORD 

055206 

.WORD 

142172 

.WORD 

004612 

.WORD 

021100 

.WORD 

000000 

.WORD 

000000 

THAN 


RETURN 


DOUBLE  OUTY 


STORAGE  FOR  10**9  (MAX  2-WORD  PWR  OF  TEN) 

NUMBER  OF  0*S  IN  10**9 

LENGTH 

OCTAL  REPRESENTATION  (HI-ORDER  FIRST) 

SAME  FOR   10**19  (4  WORDS) 


NOT  TWOS  COMPLEMENT! ! 


;  SAME  FOR  10**36  (8  WORDS) 
OR  EQUAL  TO  10**37  BUT  3  WORDS  LONG 


DCV:     ;  CONVERT  INTEGER  TO  DECIMAL  AT  NEXT-TO-TOS 
;  TOS  MUST  3E  A  DECIMAL 
MOV      (SP)»RO 
MOV      SP,6K 
MOV      3K,R1 
TST      (Rl)+ 


LENGTH  IN  RO 

DESTINATION  POINTER  FOR  MOVE 

Rl  IS 

SOURCE  POINTER 


iG7 


jG'-^ 


i^ioy/ 

(SP) ,-{Sp) 

ji: 

A0\/ 

(Rl)+, (yK)+ 

S03 

r^O.: 

Bl 

^^O'J 

#ll  1 

(BK) 

MP 

3#BIGRTN 

SBKOPS 

.Eau 

* 

■» 

i&. 

BLT 

* 

+ 

f 

BLE 

* 

+ 

4 

33E 

* 

+ 

4 

B3T 

♦ 

+ 

4 

BNE 

* 

+ 

4 

BEQ 

* 

+ 

1+ 

UBROPS 

•  EQU 

* 

_ 

16. 

BLO 

* 

+ 

4 

BLOS 

* 

+ 

<+ 

BHIS 

* 

+ 

4 

BHI 

* 

+ 

H 

BNE 

* 

+ 

4 

BE  3 

* 

+ 

4 

MOVE  L£NGTH 
MOVE  OECIMttL 

LENGTH  WORD  FOR  INTEGER 
EXIT  DECOPS 


.END 


1 

2 

3 

5 
6 

7 

a 

9 
10 
11 
12 
13 

15 
16 
17 
18 
19 
20 
21 
22 
23 
2^ 
25 
26 
27 
28 
29 
30 
31 
32 
33 
3<+ 
35 
36 
37 
38 
39 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


i:c 

i:d 


i:d 

i:d 
i;j 
:d 
:d 
:o 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:o 
:d 
:o 
:o 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

i:d 

i:o 

i:o 

1:0 


:o 
:d 
:d 
:d 
:o 
:d 
:o 
:d 
:d 


i:d 
i:d 


1 
1 

6 

3 

6 

5 

5 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

6 

3 

3 

3 

3 
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(*$L  PRIxITE^:*) 
PROGRA^I  COOESTAT; 

c 
c 

L 
C 

r 

I" 
t 

c 

c 

c 

c 

c: 

c 

c 

L 

c 

CONST    VERSION=»II,0  CA.S^'; 
MAXPROCNUM=150  5 

TYPE     NMENONIC=PACKED  ARRAYC0..73  OF  CHAR; 
3YTETYPE=ARRAYC0..7D  OF  INTEGER; 
wORDTYPE=ARRAYC0.,153  OF  INTEGER; 
3YTE=0..255; 

optype=( short* one, opt, two, lopt, words. chrsfblk»cmprss,cmprss2,  word); 
opre:c=record  case  optype  of 

short: (TOTALO: INTEGER) ; 

one.chrs,blk: (totali: integer; 

byteonei:bytetype) ; 
two:{total2:integer; 
byteone2:bytetype; 
bytetwo2:bytetype; 

FLAV0R2:ARRAYC2..29D  of  INTEGER); 

word, opt: (TotaL3:integer; 

parmone3:wordtype) ; 

L0PT:(T0TAL4:INTEGER;  r-pn 

BYTEOK   :BYTETYPE;  ^ 


370 


i+S 

i:L^ 

J 

^3 

i:j 

6 

44 

i:d 

6 

45 

i:z 

5 

46 

i:o 

6 

47 

i:d 

3 

48 

i:d 

3 

49 

i;d 

3 

50 

i:o 

3 

51 

i:d 

3 

52 

i:o 

3 

53 

i:d 

3 

54 

i:d 

3 

55 

i:d 

3 

56 

i:d 

3 

57 

i:d 

3 

58 

i:d 

3 

59 

i:d 

3 

60 

i:d 

3 

61 

i:d 

3 

62 

i:d 

3 

63 

i:d 

3 

64 

i:d 

3 

65 

i:d 

3 

66 

i:d 

3 

67 

i:d 

3 

68 

i:d 

3 

69 

i:d 

3 

70 

i:d 

4 

71 

i:d 

6 

72 

i:u 

15 

73 

i:d 

16 

74 

i:o 

17 

75 

i:d 

17 

76 

i:d 

24 

77 

i:d 

24 

78 

i:d 

24 

79 

i:d 

24 

80 

i:d 

44 

81 

i:d 

45 

82 

i:d 

47 

VAR 


INTEGER) ; 
OF  INTEGER) 


PAR^iTW04:iA,'0RDTYPE)  ; 

.vORcs:  (totaL5:integer; 

PARM0NE5:^0R0TYPEi 
PARMTl«Ob:wGRDTYPE; 
PARMTHREE5:W0RDTYPE) ; 
CWiPRSS:  (TOTALeilNTEGER; 

FLAVOR6:ARRAYC0..i+0:    OF 
CMPRSS2:  (T0TAL7:ir\ITEGER; 

FLAV0R7;ARRAYC1.,6D 

end; 

OpPTRs'^OPREC; 

opfacts=record 

NAVlES:ARRAYi:b2.,2553    OF    NMENONIC; 

rectypes:arrayco..2553  of  optype 
end; 
jumprec=record 

pos.neg:wordtype 
end; 

prclarry  =  array[:0..maxprocnum3  of  integer; 
dsptr='^dsarry; 

dsarry=arrayc0..13  of  imteger; 
hextype=packed  record  case  integer  of 

O: (DUM2,DUMl»HltLO:0..15)  ; 

i:  (hi3yte«i-owbyte:o..255)  ; 

2:(W0RD:INTEGER) 

END; 

display:boolean; 
ch»cr:char; 

PCTMAX,MAXOP,lNUM,BYTESIZEtBYTEPOSiOP,BUFSTART»PROCNUV.SEGNUM:iNTEGER; 
3ITE;BYTE; 

dsstart:dsptr; 

swap, control, console »doneproc»lexcheck»datawatch i 

LEXLOOK   :boolean; 

HEXCOUNT,MAXpROC,SEGSTBLK,BUFSTBLK,OPTOTAL, 
SEGSIZE, offset* BACK JUMP, SLDC, 
SLDL,3LD0,SlNDtPR0CSTART,DATASEG,DATAPR0C» 
DATASEGSIZE,LEXLEVEL,DATAREF,DTSGSZ, JUMPTOTAL    : INTEGER; 

hex:hextype; 

rnum:real; 

OPCODE  :ARR  A  YCC.  255  i^df  OPPTR; 


•J^n" 


Si 

i:j 

an 

i:d 

as 

i:o 

86 

i:o 

87 

i:a 

88 

i:u 

89 

i:d 

90 

i:d 

91 

i:d 

92 

i:o 

93 

i:d 

314 

i:d 

95 

i:d 

96 

i:d 

97 

10 

i:d 

98 

10 

i:d 

99 

10 

i;d 

100 

10 

i:d 

101 

10 

i:d 

102 

10 

i;d 

103 

10 

i:d 

10«+ 

10 

i:d 

105 

10 

i:d 

106 

10 

i:d 

107 

10 

2:d 

108 

10 

2:0 

109 

10 

2:1 

110 

10 

2:1 

111 

10 

2:1 

112 

10 

2:1 

113 

10 

2:1 

llf 

10 

2:1 

115 

10 

2:1 

116 

10 

2:1 

117 

10 

2:1 

118 

10 

2:1 

119 

10 

2:1 

120 

10 

2:1 

121 

10 

2:1 

122 

10 

2:1 

123 

10 

2:2 

503  LISTFILE:IfnEKACTIVE; 

^'^"^  HEXCHAR.CODE          tPACKED    ftRRAYC0..153    OF    CHAR; 

°20  iwputfileifile; 

06O  jumpstats:jumprec; 

o92  SEGL£X:ARRAYC0..153  OF  INTEGER; 

708  SEGDIREC:PACkEU  ARRAYCO..  511:1  OF  BYTE; 

'5o'+  names:arrayc52..255:  of  NMENONIC; 

1750  rectypes:packed  array[:o..255:  of  optype; 

I8f4  procs:array  ccmaxprocnum:  of  integer; 

1595  proccall:arrayc:o..153  of  '^prclarry; 

2011  jumps, PROCLEXIARRAYCO. .99:  OF  INTEGER; 

2211  lastfilename:string; 

2252  3UFFER:PACKED  ARRAYC 0 .. 25593  OF  BYTE; 
3532 

1  SEGMENT  PROCEDURE  INIT; 

1  type  rectifier=rec0rd  case  boolean  of 

1  true:(INt:integer); 

1  false: (rectype:optype) 

1  END; 

1  var       iunteger; 

2  testtype:rectifie:r; 

3  filename:string; 

'^'+  opfile:file  of  opfacts; 

l'+16 

1  PROCEDURE  newop(Flavor:optype) ; 

0  BEGIN 

0  CASE  Flavor  of 

3  SH0RT:NEW(0PC0DECn. SHORT)  ; 

20  ONE:NEW(OPCODECI3,ONE) ; 

37  8LK:NEW(0PC0DECI3,BLK) ; 

S't  CHRS:NEW(OPcODECI3»CHRS); 

71  OPT:NEW(OPCODECID,OPT) ; 

Q8  two:new(opcodecid,two) ; 

105  LOPT:NEk^{OPcODECn,LOPT)  ; 

122  wORDS:(jEW(OPcODECID,WORQS)  ; 

139  C>1PRSS:NE1«(OPcODECI3,CMPRSS)  ; 

156  CMprSS2:NEW(0PC0DECID,CMPRSS2) ; 

173  W0R0:NEW(0PC0DECI3,W0RD) 

188  end; 

220  IflilTH    0PC00ECI3'"    DO                                                                                                                                                   ^^^ 

235  CASE    FLAVOR    OF                                                                                                                                                         ^  '  1 


.) 


12 


124 

Ij 

2:2 

25d 

125 

10 

2:2 

240 

126 

10 

2:4 

245 

127 

10 

2:4 

246 

128 

10 

2:3 

254 

129 

IJ 

2:2 

256 

130 

10 

2:4 

256 

131 

10 

2:4 

259 

132 

10 

2:4 

267 

133 

10 

2:4 

275 

IS^ 

10 

2:3 

283 

135 

10 

2. -2 

285 

136 

10 

2:4 

285 

137 

10 

2:4 

288 

138 

10 

2:3 

296 

139 

10 

2:2 

298 

ito 

10 

2:4 

298 

I'+l 

10 

2:4 

301 

142 

10 

2:4 

309 

143 

10 

2:3 

317 

1^^ 

10 

2:2 

319 

I'+S 

10 

2:4 

319 

Its 

10 

2:4 

322 

1^1 

10 

2:4 

330 

148 

10 

2:4 

333 

149 

10 

2:3 

346 

150 

10 

2:2 

348 

151 

10 

2:4 

348 

152 

10 

2:4 

351 

153 

10 

2:3 

359 

154 

10 

2:2 

361 

155 

10 

2:4 

361 

156 

10 

2:4 

364 

157 

10 

2:3 

372 

158 

10 

2:2 

372 

159 

10 

2:0 

404 

160 

10 

2:0 

424 

161 

10 

1:0 

0 

162 

10 

1:1 

0 

163 

10 

1:1 

14 

164 

10 

1:1 

14 

end; 


sho:'.t:toTAlo;  =  o; 
chrs»blk,OiJE:lje&in 

TOTALi:=0; 
FiLLCHAR(3YTEONEl.l6,0)  ; 

end; 

Two: BEGIN 

TOTAL2:=0; 

fillchar (byte0ne2.16.0)  ; 
fillchar(bytetw02.16,0)  ; 
fillchar(flavor2.56,0) ; 

end; 

WORDfOPT:dEGlN 

TOTAL3:=0; 
FILLCHAR{PARMONE3i32,0)  ; 

end; 
lopt:begin 

TOTAL4:=0; 

FILLCHAR(BYTEONE4.16»0) ; 
FILLCHAR(PARMTW04i32tO); 

end; 
words:begin 

TOTAL5:=0; 

FILLCHAR(PARMONE5.32,0) ; 
FlLLCHAR(PARMTW05t32»0) ; 

fillchar(parmthree5,32,0) j 

end; 
cmprss:begin 

TOTAL6:=0; 

fillchar(flavor6»82,0) ; 
end; 
cmprss2:begin 

TOTAL7:=0; 

FILLCHAR (FLAV0R7f 12,0) ; 

END 


end; 


BEGIN(*    I[\jIT    *) 

cr:=chr(13) ; 
(*$I-*) 

RESEKOPFILE. 'OPCODES.  II. 


165 

10 

i:i 

56 

lb& 

I'u 

1:2 

42 

167 

IG 

1:5 

"42 

168 

10 

1:3 

83 

169 

10 

1:2 

92 

170 

10 

1:2 

92 

171 

10 

1:1 

92 

172 

10 

1:1 

100 

173 

10 

1:2 

116 

l7^ 

10 

1:3 

116 

175 

10 

1:3 

132 

176 

10 

1:^ 

152 

177 

10 

1:3 

166 

178 

10 

i;«+ 

174 

179 

10 

1:3 

190 

180 

10 

1:2 

204 

181 

10 

1:1 

211 

182 

10 

1:1 

219 

183 

10 

1:1 

229 

18tf 

10 

1:1 

234 

185 

10 

1:1 

305 

186 

10 

1:1 

310 

187 

10 

1:1 

339 

188 

10 

1:1 

358 

189 

10 

1:1 

358 

190 

10 

1:1 

397 

191 

10 

1:1 

397 

192 

10 

1:2 

403 

193 

10 

1:1 

415 

191 

10 

1:1 

439 

195 

10 

1:2 

453 

196 

10 

1:3 

484 

197 

10 

1:4 

484 

198 

10 

1:4 

498 

199 

13 

1:3 

515 

200 

10 

1:2 

515 

201 

10 

1:1 

535 

202 

10 

1:1 

545 

203 

10 

1:1 

550 

204 

10 

1:1 

620 

205 

10 

1:1 

699 

IF    lOkESiJLTOO    THErJ 
t3EGlfJ 

wrlttln( •♦opcodes. 15  not  qn  system  disk'); 
exit(codestat) ; 

end; 

(*4I+*) 

NAMES  :=0PFILE'^,  NAMES! 
FOR  i:=o  TO  255  DO 
BEGIN 

NEwOP(OPFILE'".RECTYPES:iD)  ; 

IF  0RD(0PFILE'*.RECTYPESCI])>255  THEN 

TESTTYPE.INT:=ORD(OPFlLE'^.RECTYPESCID)  MOD  256 
ELSE 

TESTTYPE.RECTYPE:=0PFILE'^.RECTYPESCID5 
RECTYPESCI3:=TESTTYPE.RECTYPE; 
END! 
CLOSECOPFILE); 
PAGE(OUTPUT) ; 
GOTOXY(22,10); 

WRITELNCUCSD         P-CODE         DISASSEMBLER    AVERSION)? 

GOTOXY(0«0); 

WRITE( 'INPUT  CODE  FILE:  »); 

READLN(FILENAME) ; 

OPENOLD(INPUTFILE,CONCAT(FILENAME,'.CODE')); 
(*$I+*) 

IF    lORESULT    0    0    THEN 

OPENOLOdNPUTFlLEtFlLENAME)  ; 
IF    BL0CKREAD(INPUTFILE,SEGDIREC,1)=1       THEN    ; 
FOR    SEGNUM:=0    TO    I5    DO 

IF    SegDIRECCSEGNuM*4D    +    SEGQIRECC SEGNUM*4    +    l3<>0    THEN 
BEGIN 

NEi^(PROCCALLCSEGNUMj)  ; 

FILLCHAR(PR0CCALLCSEGNUM3'^,SI2E0F(PRCLARRY)  ,0)  ; 

END 

ELSE  proccallcsegnumd:=nil; 

PAGE{0LITPUT)  ; 

GOTOXY(0»10) ; 

WRlTELr^C     ':i0t»lS    THIS    CODE    FILE    DESIGNED    FOR    A    MACHINE'); 

RmJ^KEY^oIr;™"-    '"'    '"°    ''    '''    "'"'    SIGNIFICANT    BYTE    <LSI-Xl    N0>7.M      373 
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206  10  l:i  70  9    SWAF>:  =  (CH='Y' )  OR  (CH='Y'); 

207  10  i:i  718    PAGE(OJTPUT) : 
203  10  l:i  728    GOTOXY(0»10)  ; 

209  10  i:i  735    WRITE( 'DIS-ASSEMBLY  OUTPUT  FILE  (<CR>  FOR  NONE):  •); 

210  10  l:i  737    READLN(FILENAME) ; 

211  10  i:i  806   lastfilename:=filename; 

212  10  i:i  ai3   display:  =  (filename<>"  ) ; 

213  10  i:i  d22   console:=(filename=*console:»)  or  (FILename=*#i: • ) ; 

2m  10  l:l  850    if  display  then  REwRITE(LISTFILE«FILEIMAME)  ; 

215  10  i:i  865    SEGNUM:=0; 

216  10  i:i  868   optotal:=o; 

217  10  l:i  871   sldc:=o; 

218  10  i:i  874   sldl:=o; 

219  10  i:i  877   SLDo:=o; 

220  10  i:i  880   sind:=o; 

221  10  i:i  883   jumptotal:=o; 

222  10  i:i  886   hexcount:=05 

223  10  i:i  889    C0DE:=»  »5 

224  10  i:i  913    HEXCHAR:=»0123H567e9ABCDEF' ; 

225  10  i:i  937    FILLCHaR(JUMPSTATS.POS,32iO)  ; 

226  10  i:i  945    FILLCHAR(JUMPSTATS.NEG»32«0) ; 

227  10  i:i  953   lexlook:=falsej 

228  10  i:0  956  END; 

229  10  i:0  978 

230  1  2:D      1  PROCEDURE  PROMPT;  FORWARD; 

231  1  2:d     1 

232  11  1:D      1  SEGMENT  PROCEDURE  DISASSEMBLE; 

233  11  i:d    1 

234  11  2:D      3  FUNCTION  3UFRESET (BYTEPOS, OFFSET, DIRECTION: INTEGER) : INTEGER ; 

235  11  2:D      6  VAR    NEwBYTE: INTEGER ; 

236  11  2:0      0  BEGIN 

237  11  2:1      0    NEWBYTe:=BYTEPOS  +  OFFSET; 

238  11  2:1      5    REPEAT 

239  11  2:2    5    bufstblk:=bufstblk  +  direction; 

240  11  2:2  11      BUFStaRT:=(BUFSTBLK  -  SEGST3LK)*512; 

241  11  2:1  22    UNTIL  (NEWBYTE  -  3UFSTART>=0)  AND  (NEWBYTE  -  BUFSTART<2557 ) ; 

242  11  2:1  37    IF  BLOCKREADdNPUTFlLE, BUFFER, 5»3UFSTBLK)=1  THEN; 

243  11  2:1  59    BUFRESet:=NEWBYTE  -  BUFSTART; 

244  11  2:0  64  end; 

245  11  2:0  78 

246  11  3:D      3  FUNCTION  lASTBYTE : BYTE ! 


247 

11 

3;d 

3 

248 

11 

5:o 

0 

24y 

11 

3:i 

0 

250 

11 

3:2 

5 

251 

11 

3:3 

5 

252 

11 

3:3 

13 

253 

11 

3:2 

24 

254 

11 

3:i 

24 

255 

11 

3:2 

26 

256 

11 

3:3 

26 

257 

11 

3:3 

31 

258 

11 

3:2 

37 

259 

11 

3:i 

37 

260 

11 

3:a 

54 

261 

11 

3:o 

66 

262 

11 

4:0 

3 

263 

11 

'+:d 

3 

264 

11 

4:o 

0 

265 

11 

4:i 

0 

266 

11 

'+:2 

7 

267 

11 

^:i 

18 

268 

11 

'i:! 

35 

269 

11 

f  :2 

41 

270 

11 

't:3 

41 

271 

11 

f:3 

61 

272 

11 

4:3 

82 

273 

11 

h:3 

105 

274 

11 

4:2 

111 

275 

11 

4:1 

111 

276 

11 

4:o 

116 

277 

11 

4:o 

128 

278 

11 

5:d 

3 

279 

11 

5:d 

3 

280 

11 

5:d 

4 

281 

11 

5:o 

0 

282 

11 

5:i 

0 

283 

11 

5:i 

11 

284 

11 

5:2 

lb 

285 

11 

5:3 

16 

286 

11 

5:3 

30 

287 

11 

5:3 

45 

VAR    CHANGE: INTEGER; 
6EGIN 

IF  BYTepOS<1  THEN 
BEGlrsI 

3YTEP0S:=3UFRESET(BUFSTART  +  BYTEPOS . -1 , -1 ) ; 

offs£t:=offset  -  i; 

END 
ELSE 
BEGIN 

3YTEP0S:=BYTEP0S  -  1! 

offset:=offset  -  i; 
end; 
lastbyte:=buffercbytepos3; 
end; 

FUNCTION  getbyte:byte; 
VAR  hex:hextype; 

BEGIN 

IF  BYTEP0S>2559  THEN 

BYTEPoS:=BUFRESET(BUFSTART  +  BYTEPOS,0»5) ; 

getbyte:=buffercbyteposd; 

IF  HEXcOUNT<15  THEN 
BEGIN 

hex,lowbyte:=buffercbytepos3; 
cooechexcountd:=hexcharchex,hi3; 
cooechexcount  +  13:=HEXCHARCHEX.L0D; 
hexcount:=hexcount  +  2; 
end; 
bytepos:=bytepos  +  1; 
end; 

FUNCTION  getbig:integeh; 
VAR  big:hextype? 
firstbyte:3yte; 

3EGIN 

first3yte:=getbyte; 

IF  FIRsTBYTE>127  THEN 

begin 
big.lo^byte:=getbyte; 
bi6.hibyte:=firstbyte  -  128;  ^7:^ 

getbig:=big.word;  ^ 


O  t  t) 


233 

1  1 

5:2 

4B 

LHD 

289 

5:i 

48 

ELSE  G£:TBIG:=FIRSTBYrE; 

290 

b:o 

53 

end; 

29i 

5:o 

6£. 

292 

6:d 

6 

FUNCTION  GET^ORD: INTEGER; 

293 

6:d 

3 

vAR  weRj:hextype; 

294 

6:o 

0 

BEGIN 

295 

6:i 

0 

IF  SWAP  THEN 

296 

6:2 

4 

BEGIN 

297 

613 

4 

wero.hibyte:=getbyte; 

298 

6:3 

18 

ifllERD.LOWBYTE:=GETBYTE! 

299 

6:2 

32 

END 

300 

6:i 

32 

ELSE 

301 

6:2 

34 

BEGIN 

302 

6:3 

34 

werd.lowbyte:=getbyte; 

303 

6:3 

48 

wErd.hibyte:=getbyte; 

304 

6:2 

62 

end; 

305 

6:i 

62 

getword:=werd.woro; 

306 

6:o 

65 

end; 

307 

6:o 

78 

308 

7:d 

3 

FUNCTION  mOSTSIGBIT{OPERAND:INTEGER) :INTEGER; 

309 

7:d 

4 

vAR  bytesize:integer; 

310 

7:o 

0 

BEGIN 

311 

7:i 

0 

IF  OPERAND<0  THEN 

312 

7:2 

5 

mostsigbit:=15 

313 

7:i 

5 

ELSE 

314 

7:2 

10 

BEGIN 

315 

7:3 

10 

bytesize:=-i; 

316 

7:3 

14 

REPEAT 

317 

7:4 

14 

bytesize:=bytesize  +  1; 

318 

7:4 

19 

operand:=operand  div  2; 

319 

7:3 

24 

UNTIL  OPERAND=0; 

320 

7:3 

29 

mostsigbit:=bytesize; 

321 

7:2 

32 

end; 

322 

7:0 

32 

emd; 

323 

7:0 

46 

324 

8:d 

1 

PROCEDURE  actaccess(finalex,offset:integer);  forward; 

325 

8:d 

3 

326 

9:d 

1 

PROCEDURE  SHORTOP; 

327 

9:0 

1 

CSLDC  ABI   A3R   ADI   ADR   LAND  DIF   DVl   DVR   CHK   FLO   FLT   INN   INT 

328 

9:d 

1 

LOR   MODI  MPI   MPR   NGI   Na|K  LNOT  SRS   SBI   SBR   SGS   SQI   SQR   STO 

tit  JJ  o*°  ^  ^^^  ^^'       ^^^      LDCN  lUP   STP   LD3   STB   EQUI  GEQI  STRI  LEQI  LESI  NEQI 

^20  11  9:LJ  1  SIP   1X3   BYT   XIT   SLQL  SLDO  SIND] 

331  11  9:D  1 

332  11  9:0  0  BEGIN 

^^^  11  ^'i  0  opcgde:bite3^,totalo:=opcooec3ited'^.totalo  +  i; 

^^'^  11  9:i  26  IF  BiT-:=2m  then  domeproc:=true; 

335  11  9:i  36  IF  BITE<128  THEN 

336  11  9:2  43  BEGIN 

337  11  9:3  43  SLOC:=SLDC  +  1; 

m  ]l  III  '^^  IF  DISPLAY  THEN  WRITELN  ( LISTFILE*  NAMESC127  J,  BITE:6.  '  •:i8.C0DE); 

339  11  9:2  116  END 

340  11  9:i  116  ELSE 

341  11  9:2  118  BEGIN 

342  11  9:3  118  IF  DISPLAY  THEN  WRITE (LISTFILE .NAMESCBITED) ; 

343  11  9:3  144  JF  BlTE>215  THEN 

344  11  9:4  151  IF  BITE<232  THEN 

345  11  9:5  158  BEGIN 

346  11  9:6  158  SLDL:=SLDL  +  i; 

111  J?  V^  ^^'^  ^^  DATAWATCH  THEN  ACTACCESS  (LEXLEVEL,BITE  -  215); 

lis  11  9:5  225  ^^  DISPLAY  THEN  WRITELN( LISTFILE.BITE-215:6, ♦  'IIS, CODE); 

350  11  9:4  225  ELSE  IF  BITE<248  THEN 

351  11  9:6  234  BEGIN 

352  11  9:7  234  SLDO:=SLDO  +  i; 

353  11  9:7  240  IF  DATAWATCH  THEN  ACTACCESS( 0 iBITE  -  231); 

ill  li  VJ  ^^^  ^^    DISPLAY  THEN  WRITELN{LISTFILE,BITE-23l :6, •  •:18,C0DE); 

33b  11  9:6  300  END 

356  11  9:5  300  ELSE 

357  11  9:6  302  BEGIN 

358  11  9:7  302  SIND:=SIND  +  i; 

III  JJ  l''^  308  IF  DISPLAY  THEN  WRITELN(LISTFILE,  BlTE-248:6,  •  •:18,C0DE); 

360  11  9:6  356  END 

361  11  9:3  356  ELSE 

362  11  9:4  358  IF  DISPLAY  THEN  WRITELN(LISTFILE, •  •:24fC0DE); 

363  11  9:2  392  End; 

364  11  9:i  392  IF  DONEPRQC  THEN 

365  11  9:2  396  IF  DISPLAY  THEN  |«RITELN  (LISTFILE )  ; 

366  11  9:0  407  END; 

367  11  9:0  426 

368  11  10:D  1  PROCEDURE  ONEOP;                                                             ^ 

369  11  '.0:d  1  cADJ   FJP   SAS   RNP   CiP   UJP    0«   STM   RBP   CBP   CLP   CGP   EFJ   NFj3       ^^^ 
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11 

10  :d 

1 

371 

11 

10:0 

1 

372 

11 

10:0 

2 

373 

11 

io:d 

3 

37'+ 

11 

ii:d 

1 

375 

11 

11  ;d 

1 

376 

11 

11:0 

0 

377 

11 

11:1 

0 

378 

11 

11:1 

7 

379 

11 

11:1 

17 

380 

11 

11:1 

21 

381 

11 

11:2 

21 

382 

11 

11:2 

26 

383 

11 

11:1 

31+ 

38«l 

11 

11:1 

1+1 

385 

11 

11:2 

'+'+ 

386 

11 

ii:i 

63 

387 

11 

ii;2 

68 

388 

11 

11:0 

90 

389 

11 

11:0 

10*+ 

390 

11 

10:0 

0 

391 

11 

10:1 

0 

392 

11 

10:2 

13 

393 

11 

10:3 

13 

391 

11 

10:3 

19 

395 

11 

10:3 

i+S 

396 

11 

io;3 

61 

397 

11 

10:'+ 

8*+ 

398 

11 

10:5 

8'+ 

399 

11 

10:5 

95 

too 

11 

10:6 

102 

toi 

11 

10:7 

102 

402 

11 

10:7 

108 

403 

11 

10:7 

111 

'♦01 

11 

10:7 

113 

'+05 

11 

10:8 

116 

'+06 

11 

10:6 

16'+ 

'+07 

11 

10:5 

16'+ 

'+08 

11 

10:6 

166 

'+09 

11 

10:7 

166 

4+10 

11 

10:7 

172 

VAN   juv,psize:integeh; 

PCaLL:300L£AN; 
PROCEDURE  JUMPOPST! 

vAR   neg: boolean; 

BEGIN 

NEG:=(juMP3IZE<0) ; 

IF  NEG  THEN  JUMPSIZE : =- JUMPSIZE ; 

eYTESlZE:=-l; 

repeat 

bytesize:=bytesize  +  1; 

jumpsize:=jumpsize  div  2; 
until  jumpsize=0; 
if  neg  then 

jumpstats.negcbytesize3:=jumpstats.negcbyteslzea  +  1 

ELSE 

JUMPSTATS.P0SCBYTESIZE3:=JUMPSTATS.P0SCBYTESIZE3  +  i; 

ENDJ 

BEGIN(*  ONEOP  ♦) 

WITH  0PC0DECBITE3'^  DO 
BEGIN 

T0TAL1:=T0TAL1  +  1; 

IF  DISPLAY  THEN  WRITE( LISTFILEtNAMESCBITED) ; 
IF  (BITE=173)  OR  (BITE=193)  THEN  DONEPRQC :=TRUE ; 
IF  (BITE  IN  C161»185. 211. 2123)  THEN 
BEGIN 

BITE:=GET3YTE; 
IF  BITE<128  THEN 
BEGIN 

juniptotal:=jumptotal  +  i; 

jumpsize:=bite; 

jumpopst; 

if  display  then  writeln ( listfile . 

5ufstart  +  3ytepqs  +  bite  -  pr0cstart:6. •  »:i8fc0de); 

END 
ELSE 
BEGIN 

jumptotal:=jumptotal  +  is 

JUMPSlzE:=JUMPSr(256-BITE-8)DIV  23  -  ( BUFSTART+BYTEPOS-P^START) 


P^(256-BITE-8)DIV  23  -  ( BUFSTART+BYTEPOS-P^C! 
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10:7 
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^+12 

11 

10:7 
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'^la 

11 

10:8 

204 

4if 

11 

10:6 

262 

-+15 

11 

10:4 

262 

^16 

11 

10:3 

262 

417 

11 

10:4 

264 

418 

11 

10:5 

264 

419 

11 

10:5 

282 

420 

11 

10:5 

293 

421 

11 

10:6 

296 
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11 

10:5 

336 
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11 

10:5 

380 

424 

11 

10:6 

384 
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11 

10:4 

395 
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11 

10:3 

395 

427 

11 

10:3 

402 
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11 

10:2 

424 

429 

11 

10:0 

424 

430 

11 

10:0 

440 

431 

11 

12:0 

1 

432 

11 

12  :d 

1 

433 

11 

12  :d 

1 

434 

11 

12:d 

2 

435 

11 

12:0 

0 

436 

11 

12:1 

0 

437 

11 

12:2 

13 

438 

11 

12:3 

13 

439 

11 

12:3 

19 

440 

11 

12:4 

23 

441 

11 

12:5 

23 

442 

11 

12:5 

41 

443 

11 

12:4 

59 

444 

11 

12:3 

59 

445 

11 

12:3 

85 

446 

11 

12:3 

91 

447 

11 

12:3 

93 

448 

11 

12:3 

120 

449 

11 

12:4 

124 

450 

11 

12:4 

130 

451 

11 

r2:3 

141 

JUMPOPST! 

IF  DISPLAY  THEN  WRITELN { LISTFILE 1 

JUVIPSC{256  -  BITE  -  8)  DIV  23:6, •  'UStCODE); 

END 
ELSE 
BEGIN 

PCALL:  =  (BITE  in  Cl7t+,206.2073)  ; 

BITE:=GETBYTE; 

IF  PCALL  THEN 

PROCCALLCSEGNUM3'^CBITE3:=PROCCALLCSEgNUM3'*CBITED  +  1; 
IF  DISPLAY  THEN  WRITELN ( LISTFILE»BITE:6. »  'US, CODE) 5 
IF  DONEPROC  THEN 

IF  DISPLAY  THEN  WRITELN(LISTFILE ) ; 

end; 

BYTESIZE:=M0STSIGBIT(BITE) ; 

BYTE0NE1CBYTESI2E3:=BYTE0NE1CBYTESIZED  +  1: 
END? 

END? 

PROCEDURE  OPTOPJ 

CINC   IND   IXA   LAO   LDO   MOV  ^\JB      SRO   LLA   LDL   STL   BTP3 

VAR   big:integer?  "" 

LOCAL* GLOBAL: BOOLEAN? 

BEGIN 

WITH  0PC0DECBITE3'*  DO 
BEGIN 

T0TAL3:=T0TAL3  +  1? 
IF  DATAWATCH  THEN 
BEGIN 

LOCAL:=(BItE  in  C198.202.204D); 
GL0BAL:=(BITE  in  C165.167.1713); 
END? 

IF  DISPLAY  THEN  WRITE (LISTFILE.NAMESCBITE3) ? 

3Ig:=6etbig; 

BYTESI2E:=M0STSIGBIT(8IG); 

PARM0NE3CBYTESlZEa:=PARM0NE3CBYTESlZE:  +  1; 
IF  DATAWATCH  THEN 

IF  LOCAL  THEN  ACTACCESS ( LEXLEVEL,BIG ) 

ELSE  IF  GLOBAL  THEN  ACTACCESS  (  0  ,BIG)  ;  ^.^^ 

IF  DISPLAY  THEN  WRITELN/  'STFILE.BIG:6, »  »:18,C0DE)?  ^*^ 


380 


>*^2  11  12:2  135    e^^d; 

453  11  li::o  185  E^MD; 

'+5'+  11  12:d  19d 

155  11  13:D      1  PROCEDURE  LOPTOP; 

^+56  11  i3:d    1  cLDA  lod  str: 

^57  11  13:D  1    VAR         3l3,Lll\IKS:iNTEGER; 

458  11  13:0  0    BEGIN 

459  11  13:i      0    WITH  OPCODECBITED'^  DO 

460  11  13:2     13      BEGIN 

461  11  13:3     13        T0TAL4:=T0TAL4  +  1; 

462  11  13:3     19        IF  DISPLAY  THEN  WRITE ( LISTFILE.NAMESCBITE3) ! 

463  11  13:3     45        3lTE : =GETBYTE ; 

464  11  13:3     56        IF  DISPLAY  THEN  WRITE ( LISTFILE. BITE; 6 ) ; 

465  11  13:3     69        LlNKS:=BITE; 

466  11  13:3     72        BYTESIZE : =MOSTSlGBIT{BITE) ; 

467  11  13:3     79       BYTE0NE4C8YTESIZE3:=BYTE0NE4CBYTESIZE3  +  1; 

468  11  13:3  101       BlG:=GETBie; 

469  11  13:3  107        BYTESIZE:=M0STSIGBIT(BIG) ; 

470  11  13:3  114        PARMTW04I:BYTESIZE3:=PARMTW04CBYTESIZE:  +  li 

471  11  13:3  136        IF  DATAWATCH  THEN  ACTACCESS ( LEXLEVEL  -  LINKStBIG); 

472  11  13:3  147       IF  DISPLAY  THEN  WRITELN ( LISTFILE.BIG:6, •  •:l2tC0DE)J 

473  H  13:2  191      END? 

474  n  i3:o  191  end; 

475  11  13:o  204 

476  11  14:D      1  PROCEDURE  TWOOP; 

477  11  14:D      1  CIXP   CXP3 

478  11  14:d    1  vAR   byteone»bytetwo:byte ; 

479  11  14:d     3      extpr:800lean; 

480  11  14:0      0  BEGIN 

481  11  14:i      0    WITH  0PC0DECBITE3'*  DO 

482  11  14:2     13      BEGIN 

483  11  14:3     13        T0TAL2:=T0TAL2+  l; 

484  11  14:3     19        IF  DISPLAY  THEN  WRItE(LISTFILE,NAMESCBITED) ; 

485  11  14:3     45        IF  BlTE=205  THEN  EXTPR:=TRUE  ELSE  EXTPR :=FALSE5 

486  11  14:3   60      byteone:=getbyte; 

487  11  14:3    71      bytesize:=mostsigbit<byteone) ; 

488  11  14:3     78        BYTE0NE2CBYTESIZE D : =BYTE0NE2C BYTESiZE 3  +  1; 

489  11  14:3  100        BYTETW0:=GETBYTE5 

490  11  14:3  111      doneproc:=(Extpr)  and  (byteone=o)  and  (BYTETW0=2); 

491  11  14:3  122      if  (extpr)  and  (byteone=0)  and  (bytetw0>1)  and  (bytetwo<30)  then 

492  11  14:4  137  3'GlM 
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11 
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495 

11 

14:4 

222 
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11 

14:3 
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497 

11 
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224 

496 

11 

14:5 

224 
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11 

14:6 

227 

500 

11 

1415 

267 

501 

11 

14:4 

321 

502 

11 

14:3 

321 

503 

11 

14:3 

328 

504 

11 

14:2 

350 

505 

11 

i4:o 

350 

506 

11 

i'+:o 

362 

507 

11 

i'+:o 

362 

508 

11 

i5:o 

1 

509 

11 

15:d 

1 

510 

11 

15:d 

1 

511 

11 

i5:o 

0 

512 

11 

I5:i 

0 

513 

11 

15:2 

13 

514 

11 

15:3 

13 

515 

11 

15:3 

19 

516 

11 

15:3 

45 

517 

11 

15:3 

51 

518 

11 

15:3 

95 

519 

11 

15:3 

102 

520 

11 

15:2 

124 

521 

11 

i5:o 

124 

522 

11 

i5:o 

136 

523 

11 

16:d 

1 

524 

11 

16:d 

1 

525 

11 

16:d 

1 

526 

11 

i6:o 

0 

527 

11 

i6:i 

0 

528 

11 

16:2 

13 

529 

11 

16:3 

13 

530 

11 

16:3 

19 

531 

11 

16:3 

45 

532 

11 

16:3 

59 

533 

11 

^.6:3 

65 

FLAV0R2i:BYT£:Tw03:=FLAV0K2CEYTETW03    +    1? 

IF    DISPLAY    THEN    WRITELN ( LISTFlLE . MAMESC 56    +    BYTETW03,»     •:i6iC0DE); 

ENO 

ELSE 
3EGIfg 

IF    EXTPR    THEN 

PR0CCALLC8YTE0NE3^[:3YTETW0D:=PR0CCALL[:BYTE0NE3''CByTETW03    ♦    l; 
IF    DISPLAY    THEN    WRiTELN ( LISTFILE»BYTE0NE:6»BYTETW0:6, ♦     »:i2.C0DE); 

END! 

bytesize:=mostsigbit(bytetwo)  ; 

BYTETW02CBYTESI2E3:=BYTETW02CBYTESIZE:3    +    1; 

end; 
end; 

PROCEDURE  WORDOP; 
C   LCI   3 

vAR   werd:inteser; 
begin 
with  opcodecbitej'^  do 

begin 

T0TAL3:sT0TAL3+  1» 

IF  DISPLAY  THEN  WRITElLISTFILEt NAMESCBITE3) ; 

werd:sgetword; 

IF  DISPLAY  THEN  WRITELN(LISTFILE. WERD:6» •  'UaiCODE)* 
BYTESIZE:=M0STSI6BIT(WERD) ; 
PARM0NE3CBYTESI2E3:=PARM0NE3CBYTESIZE3  •♦•  l5 

end; 
end; 

PROCEDURE  WORDSOP; 

c  xjp  : 

VAR    W0RDltW0RD2tW0RD3:iNTE6ER; 
BEGIN 

WITH  OPCODECBITED^  DO 
BEGIN 

T0TAL5:=T0TAL5  +  1; 

IF  DISPLAY  THEN  WRITE ( LISTFILE» NAMESCBITE3) ; 

IF  oOD(BYTEPOS)  then  3ITE:=GETBYTE; 

wordi:=getword;  ^„. 

BYTESlZE:=iyOSTSlGBlT(WOp       )  ;  ->c5l 
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534  11  1&:3  7.:;  PA^viO:j£oCBYTESlZt3:=PARviONLbL8YTt.SlZfc.D    +    1; 

535  li  16:3  -H  ■w'0-^D2:=SET«i;0Ru; 

53b  11  16:3  ICD        5YrESlZt::=W0STSly3ir(W0RD2)  ; 

537  11  16:3  137        PAR;*^TW05CBYTESlZt3:=PARMTW05CBYTESlZED  +  1; 

538  11  16:3  129        BYTESIZE :  =^^OSTSlGBIT  ( WORD2-wORDl  +  l )  ; 

539  11  16:3  mo        PArs/iTHRlE5CBYTESIZE3:=PaR^THREE5CBYTESIZED  +  l; 
5^+0  11  16:3  162        3ITE:=GET3YTE;    BrTE:=GETBYTE; 

Si+l  11  16:3  la^f        IF  3ITE<128  THEN 

5^+2  11  16:'+  191  W0RD3:=BUFSTART  +  BYTEPOS  +  BITE  -  PROCSTART 

5f3  11  16:3  196        ELS^ 

5'+4  11  16:4  2Q3  »J0RD3 1  =JUMPSC  ( 256  -  BITE  -  8)  DIV  21; 

51+5  11  16:3  223        IF  DISPLAY  THEN  WRITELN  ( LiSTFILEi  WORDl  :6«  W0RD2 :6»  W0RD3: 6«  •  ♦:6,C0DE); 

5f6  11  16:3  287        W0rd2:=W0RD2  -  WORDl  +  i; 

547  11  16:3  294        FOr  W0RD1:  =  1  TO  i^0RD2  DO 

548  11  16:4  305  BEGIN 

549  11  16:5  305  HEXCOUNT:=o; 

550  11  16:5  308  CODE:=*  •; 

551  11  16:5  332  W0RD3:=GETW0RD ; 

552  11  16:5  333  W0R03 : =BUFSTART  +  BYTEPOS  -  WORDS  -  2  -  PROCSTARTi 

553  11  16:5  350  IF  DISPLAY  THEN  WRITELN ( LISTFlLE » W0RD3: 41 , •  •:l8tC0DE); 

554  11  16:4  394  ruQ; 

555  11  16:2  401    end; 

556  11  i6:o  401  end; 

557  11  16:0  416 

558  11  17:D      1  PROCEDURE  Cf-^PRSSOPi 

559  11  17:D      1  C   CSP  2 

560  11  17:0      0  BEGIN 

561  11  17:i      O    WITH  OPcODECBITED'*  DO 

562  11  17:2  13      BEGIN 

563  11  17:3  13        T0TflL6:=T0TAL6  +  1; 

564  11  17:3  19     if  display  then  write( listfilef namescbited ) ; 

565  11  17:3  45      bite:=getbyte; 

566  11  17:3  56        IF  DISPLAY  THEN  WRITELN(LlSTFILE.NAMESCa6  +  SITED,'  'life, CODE); 

567  11  17:3  115       FLav0R6CBITED:=FLA\/0R6CBITE:  +  i; 

568  11  17:2  137      END? 

569  11  i7:o  137  end; 

570  11  17:0  150 

571  11  17:0  150 

572  11  18:D      1  PROCEDURE  CMPRSS20P; 

573  11  18:D      1  CEQU   GE3   GTR   LEQ   LES   NEQD 

574  11  18:0      1  \/AR    Bl3:INTE6ER; 


575 

576 

577 

578 

579 

580 

581 

582 

583 

584 

585 

586 

587 

588 

589 

590 

591 

592 

593 

594 

595 

596 

597 

593 

599 

600 

601 

602 

603 

604 

605 

606 

607 

608 

609 

610 

611 

612 

613 

614 

615 


11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 


18 

18 

18 

IS 

18 

18 

18 

18 

18 

18:4 

18:4 

16:4 
18:4 
18:4 
18:4 
18:4 
18:4 
18:2 
i8:o 
i8:o 
19:d 
19:d 
19:d 
i9:o 
i9:i 
19:2 


19:3 
19:3 
19:3 
19:3 
19:3 
19:3 
19:3 
19:4 
19:3 
19:4 
19:3 
19:2 
i9:o 
i9:a 
■'9:0 


0 
13 
13 
19 
45 
56 
86 
101 
104 
107 
156 
205 
254 
303 
362 
419 
450 
450 
468 
1 
1 
1 
0 
0 
13 
13 
19 
45 
56 
85 
92 
114 
117 
141 
150 
174 
195 
193 
212 
212 


WITH  OpcODECBITED'^  DO 

BEGliM 

t0tal7:=t0tal7 
if  display  the 
bite:=getbyte; 
flav0r7cbite  d 

IF  (3ITE=10)  0 

IF  DISPLAY  THE 

CASE  BITE  OF 

2:WRITELiM 

4:WRITELN 

6:WRITELN 

8:WRITELN 

10:WRITELN 

12:WRITELN 

END! 

end; 
end; 


+  i; 

N  WRITE(LISTFILE.NAMESCBITE3) ; 

IV  2D:=FLAV0R7CBITE  DIV  22    +15 
R  {BITE=12)  THEN  3IG:=GETBIG; 

N 


{LISTFILE,»REAL' 
(LiSTFlLEt'STR  • 
(LISTFILE,»300L' 
(LISTFILE,»P0WR' 
(LISTFILE,»3YTE» 
(LISTFILE,«W0RD» 


*:20tCODE) ; 

' :20.coDE) ; 


•  •:20iCODE); 

»  •:20iCODE){ 
BIG:6»'  •:14«C0DE); 
BI6:6f'  •:14»C0DE) 


PROCEDURE  CHRSOP; 

C   LCA   a 

VAR      SKlPOVER,i:iNTEGER; 

SEGKM 

WITH  0PC0DEC8ITE3'*  DO 
BEGIN 

TOTALl:=TOTALl  +  1; 

if  display  then  wrije (listfile, namescbited) ; 
bite:=getbyte; 

IF  DISPLAY  THEN  WRITE(LISTFILE.3ITE:6, »    »••); 

bytesize:=mostsisbit(bite) ; 
byteoneicbytesized:=byteoneicbytesi2E3  +  1; 

IF  DISPLAY  then 

FOR  l:=l  TO  BITE  DO  WRITE < LISTFlLE iCHR (GeTBYTE) ) 

ELSE 

for  i:=l  to  bite  do  skipover :=getbyte ; 
if  display  then  writeln (listfilet • • • • ) ; 

end; 
end; 


JO 


34 


6X6 

11 

20  :q 

I 

617 

11 

2o:d 

1 

613 

11 

2o:d 

1 

619 

11 

2o:o 

0 

620 

11 

2o:i 

0 

621 

11 

20:2 

13 

622 

11 

20:3 

13 

623 

11 

20:3 

1? 

624 

11 

20:3 

45 

625 

1 1 

20:3 

56 

626 

11 

20:3 

100 

627 

11 

20:3 

107 

628 

11 

20:3 

129 

629 

11 

20:3 

138 

630 

11 

20:4 

149 

631 

11 

20:5 

149 

632 

11 

20:5 

152 

633 

11 

20:5 

176 

634 

11 

20:5 

182 

635 

11 

20:4 

226 

636 

11 

20:2 

233 

637 

11 

20:0 

233 

638 

11 

20:0 

248 

633 

11 

20:0 

248 

639 

11 

20:0 

248 

6'tO 

11 

20:0 

248 

6'+l 

11 

20:0 

248 

6'+2 

11 

2i:d 

1 

6'+3 

11 

2i:d 

1 

&'+«+ 

11 

21:0 

2 

645 

11 

2i:d 

4 

646 

22:d 

1 

647 

22:d 

1 

648 

22:0 

0 

649 

22:1 

0 

650 

22:1 

14 

651 

22:2 

14 

652 

22:2 

20 

653 

22:2 

26 

654 

22:2 

37 

655 

22:3 

41 

PKOCclOURE    3LK0P; 

L       LDC       ] 

VAR   WERD,ItSKIPa\/ER:INTE&ER; 

SEGIM 

WITH  OPCODECBITE]'^  DO 

TOTALi:=TOTALl  +  1; 

if  display  then  write ( listfile f namesc3ite 3 ) ; 

bite:=getbyte? 

if  display  then  writeln ( listfile tbite : 6 ♦ »  »:18.c0de){ 

BYtESI2E:=M0STSIGBIT{BITE) ; 

BYTEONElCBYTESlZEa:=BYTEONElCBYTESlZED  •••  1; 
IF  ODD(BYTEPOS)  THEN  SKIPOVER: =GETBYTE ; 
FOR  l:=l  TO  BITE  DO 
BEGIN 

hexcount:=o; 

COOE:='  ♦; 

weRd:=6ETword; 

IF  DISPLAY  THEN  WRITELN ( LISTFILE , WERD:41 , •  •:18,C0DE); 

END; 

end; 
end; 

(*$I  DlSflSMl.TEXT  *) 

cstart  of  disasm1.text3 
ccopyright  (c)  regents  of  university  of  california  at  san  dieg03 

procedure  procejur; 
\/AR  hex:hextype; 

linenum,lprocnum: integer; 

procedure  jumpinfo; 
var  otherbyteiinteger; 

BEGIN 

BACKjUv|p:=0;  BYTEPOS:=BYTEPOS  -  6;  OFFSET:  =OFFSET  -  6; 
REPEAT 

backjump:=backjump  +  i; 

otherbyte:=lastbyte; 

bite:=lastbyte? 

if  swap  then  cjumps  relative  to  start  of  segment] 

jUv|PSCBACKJUMPj:=BUFS-p|£T    +    3YTEP0S    -    BITE*256    -    OTHERBYTE 


656 

11 

22:2 

bG 

657 

11 

22:3 

65 

65a 

11 

22:i 

65 

659 

11 

22:i 

87 

660 

11 

22:3 

95 

661 

11 

22:1 

95 

662 

11 

22:1 

105 

663 

11 

22:1 

119 

66^ 

11 

22:2 

127 

665 

11 

22:1 

135 

666 

11 

22:2 

143 

667 

11 

22:1 

119 

668 

11 

22:1 

151 

669 

11 

22:2 

175 

670 

11 

22:0 

208 

671 

11 

22:0 

221 

672 

11 

21:0 

0 

673 

11 

21:1 

0 

67*1 

11 

21:2 

16 

675 

11 

21:1 

57 

676 

11 

21:2 

59 

677 

11 

21 ;  3 

59 

678 

11 

21:3 

86 

679 

11 

2i:f 

91 

660 

11 

2i;3 

116 

681 

11 

21:5 

131 

662 

11 

21:3 

112 

683 

11 

21:3 

11a 

681 

11 

21:3 

151 

685 

11 

21:3 

160 

666 

11 

21:3 

165 

687 

11 

21:3 

177 

686 

11 

21:1 

185 

689 

11 

2i:5 

190 

690 

11 

21:1 

266 

691 

11 

21:5 

268 

692 

11 

21:6 

268 

693 

11 

21:6 

270 

691 

11 

21:6 

273 

695 

21:7 

276 

696 

■•.1:7 

322 

ELSE 

BE3IN 

JU«IPSI:BACKJJ,ViP3:=3UFSTART    +    BYTEPOS    -    BITE    -    0THERBYTE*256; 

3lTE:=0THER3YTfc:; 
END; 
UNTIL    (BITE>127)    OR    ( BACKJU|V|P  =  99 )  ; 
JUMPSC03:=BACKJUMP    -    1; 
IF    BYTEPOS    -    OFFSET<0    THEN 

BYTEPOS:=BUFRESET(BUFSTART    +    BYTEPOS . -OFFSET, -1 ) 

ELSE 

BYTEPOS;=BYTEPOS  -  OFFSET; 

procstart:=bufstart  +  bytepos;  cjumps  now  relative  TO  START  OF  procedure: 

FOR  8AckJUMF:=1  to  JUMPSC03  DO 

jumpscaackjump3:rjumpscbackjumpd  -  prqcstart; 

end; 

begin  {♦procejur*) 
if  procscprocnum3=0  then 

WRITELN(»PR0CEDURE    NOT    IN    FILEM 
ELSE 

BEGIN 

BYTEP0S:=SEGSIZE  -  BUFSTART  -  2*(PR0CNUM  +  1)  -  PR0CSCPR0CNUM3  -  21 
IF  BYTEPOS<0  THEN 

BYTEP0SI=BUFRESET(SEGSIZE  -  2*(PR0CNUM  +  1) t-PRQCSCPROCNUMD  -  2f-l) 
ELSE  IF  BYTEP0S>2556  THEN 

bytepos:=bufreset(Bufstart  +  bytepos, Of X) ; 
offset:=getword;  c  pointer  to  enter  ic  i 

lprocnum:=getbyte; 

LExLEVEL:=GET8YTE; 

bytepos:=bytepos  -  i; 

IF  LEXLEVEL=255  THEN  LEXLEVEL:=-1 ; 
IF  NOT  (LEXCHECK  OR  LEXLOOK)  THEN 
IF  LPROCNUM=o  THEN 

WRITELN( 'PROCEDURE  • ,PR0CNUM: 3, •  IS  WRITTEN  IN  ASSEMBLY.') 
ELSE 
BEGIN 

JU^IPINFO; 

OONEPROC:=FALSE; 

IF  DISPLAY  THEN  WRITELN(LISTFILE » 

♦  'riOt'BLOCK  #•, BYTEPOS  DIV  512  ■•■  aUFSTBLK:3,  'toq 

OFFSET  7       BLOCK=», BYTEPOS  MOD  512:3, CR,  ^^^ 


•—  r-)  r? 

JoD 


697 

11 

21:7 

37^;' 

698 

11 

21:6 

'4  t!  3 

699 

11 

21:7 

450 

700 

11 

21:7 

502 

701 

11 

21:6 

514 

702 

11 

2i;6 

517 

703 

11 

21:7 

517 

704 

11 

21:7 

525 

705 

11 

21:8 

568 

706 

11 

21:7 

643 

707 

11 

21:8 

656 

708 

11 

21:9 

656 

709 

11 

21:9 

000 

710 

11 

21:9 

671 

711 

11 

21:8 

704 

712 

11 

21:7 

704 

713 

11 

21:7 

707 

7m 

11 

21:7 

731 

715 

11 

21:7 

742 

716 

11 

21:7 

748 

717 

11 

21:7 

763 

718 

11 

21:7 

767 

719 

11 

21:7 

771 

720 

11 

21:7 

775 

721 

11 

21:7 

779 

722 

11 

21:7 

783 

723 

11 

21:7 

787 

72'* 

11 

21:7 

791 

725 

11 

21:7 

795 

726 

11 

21:7 

799 

727 

11 

21:7 

803 

728 

11 

21:7 

803 

729 

11 

21:6 

836 

730 

11 

21:5 

840 

731 

11 

21:2 

840 

732 

11 

21:0 

840 

733 

11 

21  ;o 

862 

734 

11 

23:d 

1 

735 

11 

23:d 

1 

736 

11 

23:d 

5 

737 

11 

23:o 

156 

•SEGrlENT  PRnC      OFFSETt*'.'  •:35i'HEX  CODE*); 
IF  NOT  CONSOLE  THEN 

IF  CONTROL  THEN  WRITE ( CK . ' C ' , PROCNUM ; 2 . • D • ) 
ELSE  WRITE( •.') ; 
LINENU:^:  =  0; 
REPEAT 

HEX.W0R0:=13UFSTART  +  BYTEPOS  -  PROCSTART; 

IF  DISPLAY  THEN  WRI TE ( LISTFlLE t SEGNUm: 7 , PRQCNUM; 5 , HEX , WORD  1 6 » ' ( • 

HEXCHARCHEX.DuMlD.HEXCHARCHEX.HlDiHEXCHARLHEX.LOD.M:    •): 
IF  CONTROL  AND  NOT  CONSOLE  THEN 
BEGIN 

writecm; 
linenum:=linenum  +  i; 

IF  (LINENUM  MOD  50=0)  THEN  WRITE(CR»»     •); 

END; 

hexcount:=o; 

code:=»  •; 

bite:=getbyte; 
optotal:=optotal  +  i; 
case  rectypesc8ite3  of 
short:shortop; 
CMPRSs:CMPRSsop; 

CMPRSS2:CMPRSS20P; 

ONEtONEOP? 

CHRS:CHRSOP; 

BLK;BLK0P; 

opt:optop; 

lopt:loptop; 

Two:TwooP; 

words: WORDSOP; 

word:wordop 
end; 

UNTIL  DONEPROC; 

end; 


END 


end 


PROCEDURE  ALLPROCS; 

VAR  I,J.V!AXDIST.INDEX:INTEGER; 

SORT!n1UMS:ARRAYC0..MAXPROCNUMD    OF    INTEGER; 

SORTpROCS:ARRAYC0.»MAXPiiCN'Jwi3    OF    BYTE; 


'MCI 


738 

23:o 

0 

739 

23:i 

0 

710 

23:2 

3 

7m 

23:3 

3 

7^+2 

23:3 

11 

7if3 

23:3 

52 

71t+ 

23:i 

77 

715 

23:5 

77 

7'+6 

23:5 

80 

717 

23:5 

83 

718 

23:6 

108 

719 

23:7 

123 

750 

23:6 

123 

75X 

23:8 

136 

752 

23:7 

139 

753 

23:5 

116 

751 

23:5 

166 

755 

23:5 

191 

756 

23:i 

220 

757 

23:3 

227 

758 

23:i 

252 

759 

23:5 

252 

760 

23:5 

265 

761 

23:5 

302 

762 

23:i 

30«+ 

763 

23:2 

311 

761 

23:i 

311 

765 

23:3 

338 

766 

23:i 

338 

767 

23:i 

375 

768 

23:3 

377 

769 

23:o 

381 

770 

23:o 

410 

771 

2i:d 

1 

772 

2i:o 

0 

773 

2i:i 

0 

771 

21:2 

1 

775 

21:3 

1 

776 

21:3 

20 

777 

21:2 

55 

778 

?i:i 

5b 

IF    DISPLAY    THEN 
BtGlivi 

sortnums:=procs5 

FOR  i:=i  to  i>^axpkocnum  do  S0RTPR0csciD:=i; 

FOR  l:=l  TO  PROCSCOD  DO 
BEGIN 

maxdist:=o; 
iNDEx:=o; 

FOR  j:=i  to  procscod  do 
IF  sortnumscj3>=maxdist  then 

BEGIN 

maxdist:=sortnumscjj; 

iNDEx:=J; 
end; 
sortnumscindex3:=sortnumsci]; 
sortnumsc i  3: =sortprocscindex 3 ; 
s0rtpr0cscindex3:=s0rtpr0csci3; 

END? 
FOR  l:=l  to  PROCSC03  DO 
BEGIN 

PR0CNUM:=S0RTNUMSCI3J 

if  (not  console)  and  (i  mod  50=0)  then  write(cr«*    mj 
prqcejur; 
END; 

END 
ELSE  FOR  PR0CNUM:=1  TO  PROCSCOl  DO 
BEGlM 

if  (not  console)  and  (procnum  mod  50=0)  then  write(cr«»    •)» 
procejur; 

end; 

END; 

PROCEDURE  SEGMINT; 

3EGIN 

IF  SWAP  THEN 
BEGIN 

SEgsT8LK:=SEG0IRECCSE6NUM*1  +  13; 

SEGSIZE:=SEGDIRECCSEGNUM*1    +    33    +    SEGDIRECCSEeNUM*1    +    23*256; 
E^ND  ^o-* 

ELSE  ->t3/ 


33S 


773 

11 

24:2 

b7 

730 

11 

24:3 

57 

7dl 

11 

24:3 

71 

762 

11 

24:2 

lOfe 

733 

11 

24:i 

106 

784 

11 

24:i 

110 

785 

11 

24:2 

Ha 

786 

11 

24:i 

123 

787 

11 

24:2 

131 

783 

11 

24:i 

142 

789 

11 

24  :i 

164 

790 

11 

24:i 

184 

791 

11 

24:i 

229 

792 

11 

24:o 

239 

793 

11 

24:o 

254 

794 

11 

8:d 

1 

795 

11 

8:d 

3 

796 

11 

8:d 

5 

797 

11 

8:o 

0 

798 

11 

8:i 

0 

799 

11 

8:2 

20 

800 

11 

8:3 

26 

801 

11 

8:4 

26 

802 

11 

8:4 

32 

803 

11 

8:4 

35 

804 

11 

8:4 

66 

805 

11 

a:4 

72 

806 

11 

8:5 

72 

807 

11 

8:5 

34 

808 

11 

8:3 

84 

809 

11 

8:2 

84 

810 

11 

8:4 

97 

811 

11 

8:5 

97 

812 

11 

8:5 

100 

813 

11 

8:5 

131 

814 

11 

8:5 

137 

815 

11 

8:6 

137 

816 

11 

3:6 

149 

817 

11 

8:4 

149 

813 

11 

8:0 

149 

819 

11 

8:0 

168 

SE:5sT3LK:=SEGaiRLCCSEGNU^*4:i; 

SEgsIZE:=SE:GDIrECCSE.GnU^I*4    +    3J*256    +    SEGDIRECi:sEGIgUM*4    +    21; 
END! 
BUFST3lk:=SEGST3LK: 
IF    SEGSIZE>2560    THEN 

BYTEPOS:=BUFRESET(SEGSlZEf-l,l) 
ELSE 

8YTEPOS:=BUFRESET(SEGSIZEf-l,0)  ; 
PROCSt:03:=BUFFERi:3YTEPOS3!   (*  NUMBER  OF  PROCS  IN  SEGMENT  *) 
BYTEPOS:=BYTEPOS  -  2*PROCSC0J  -  1; 

FOR  pRocr\iuwi:=pRocsco:]  downto  i  oo  procs[:procnumd:=getword; 

IF  NOT  (CONTROL  OR  LEXCHECK)  THEN  ALLPROCS; 

end; 

PROCEDURE  ACTACCESS5  CFINaLEX , OFFSET: INTEGER ; 3 

var  finalproctfinalseg: integer; 
inside:boolean; 

BEGIN 

IF  (FINALEX=PR0CLEXCDATAPR0CD)  and  (PR0CNUM>=DATAPR0C)  THEN 

IF  segnum=dataseg  then 

BEGIN 

inside:=(procnum=dataprqc) ; 
finalproc:=procnuw!; 

WHILE  proclex[:finalprocd>proclexcdataproc3  00  finalproc:=finalproc  - 
IF  finalproc=dataproc  then 

C$R-3 

DSSTART^COFFSETD:=DSSTART'^COFFSETa  +  1; 
C$R+D 

END 
ELSE  IF  (DATAPR0C=1)  AND  ( SEGNUM>DATASEG)  THEN 
BEGIN 

finalseg:=segnum; 

WHILE  SEGLEXCFINALSEG3>SEGLEXCDATASEG3  DO  FINALSEG:=FINALSEG  -  I; 
IF  FINALSEG=DATASEG  THEN 

C$R-3 

DSSTART'^C0FFSET3:=DSSTART'^C0FFSET3  +  I; 

END; 

eind; 


820 

25 

:o 

1 

821 

2b 

:d 

1 

822 

25 

:o 

1 

823 

25 

:d 

1 

824 

25 

:d 

3 

325 

25 

:d 

4 

826 

26 

:d 

1 

827 

26 

:□ 

1 

828 

26 

:o 

0 

829 

26 

;i 

0 

830 

26 

:i 

2 

831 

26 

:i 

7 

832 

26 

12 

11 

833 

26 

\Z 

11 

83f 

26 

:3 

17 

835 

26 

:3 

30 

836 

26 

;3 

36 

837 

26 

:2 

51 

838 

26 

:i 

51 

839 

26 

\2 

53 

840 

26 

13 

53 

841 

26 

,3 

63 
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26 

:3 

72 

843 

26 

13 

82 
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26 

:2 

93 
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26 

;i 

93 
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26 

.0 

99 
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0 
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D 

1 
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0 

0 
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1 

0 
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X 

20 
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23 
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42 
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27: 
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3 
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3 
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3 
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PROCEDUKE  PROCGUIDE; 
TYPE   SPACEPTR  =  '*SPACr; 

SPACE=ARRAYC0..19D 

vAR   i.j:integer; 

dsspace:spaceptr; 


OF  integer; 


PROCEDURE  DATASEGINFo; 

VAR  temp:integer; 

BEGIN 

procejur; 

bytepos:=bytepos  -  2; 
if  swap  then 

BEGIN 

dtsgsz:=lastbyte! 

dtsgsz:=dtsgsz  +  LASTBYTE*256; 

temp:=lastbyte; 

dtsgsz:=dtsgsz  +  lastbyte*256  +  temp; 

END 
ELSE 

begin 
dtsgsz:=lastbyte*256; 
DTSGSZ:=DTSeSZ  +  lastbyte; 
temp:=lastbyte*256; 
dtsgsz:=dtsgsz  ■»•  lastbyte  ■••  temp; 
end; 
dtsgsz:=otsgsz  div  25 
end; 

PROCEDURE  PROCLOOK; 
BEGIN 

gotoxy(0»3);  write(»  'rso);  gotoxy(0«3)5 
lexlook:=true; 

i:={PROCSC0D  DIV  5)  +  1; 

FOR  j:=0  TO  ( (PROCSCOJ-l)  DIV  I)  DO  WRITE(« 

writeln; 

FOR  PRocNUM:=1  to  PROCSC03  DO 

BEGIN 

dataseginfo; 

60toxy(15*{ (procnum-1)  div  i ) . 5+ ( ( procnum-1 )  mod  i)); 
wRitE(procnum:5»':',lexlevel:3»dtsgsz:6) ; 
end; 


LL   SIZE'); 
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861  11  ;i7:i  212  FOR  j:=l  TO  (5  -  (PROCSC03  f^OD  5))  DO  WRITELN5 

862  11  27:i  259  PROMPT; 

863  11  27:i  262  LEXLOOk : =FALSE ; 
861+  11  27:0  265  END! 

865  11  27:o  28'+ 

866  11  25:a  0  BEGIN  CPR0CGUIDE3 

867  11  25:i  0  SEGMINT? 

868  11  25:i  2  REPEAT 

869  11  25:2  2  PAGE ( OUTPUT ) J 

870  11  25:2  12  WRITE( 'PROCEDURE  GUIDE:   **(0F  PROCEDURE),'); 

871  11  25:2  58  IF  LeXCHECK  THEN 

872  11  25:3  62  WRITELN{ 'L ( ISTING ) , Q ( UIT) • ) 

873  11  25:2  98  ELSE 

87»+  11  25:3  100  WRITELN(»A(LL)»L(ISTING),Q(UIT)' )  ; 

875  11  25:2  142  WRITeC   TO  SEGMENT:  •){ 

876  11  25:2  168  FOR  i:=l  TO  8  DO  WRITE ( CHR ( SEGDIRECC63  +  SEGNUM*8  +  13)); 

877  11  25:2  211  procnum:=o; 

878  11  25:2  214  write (crtcr, • which  procedure  •); 

879  11  25:2  262  IF  LeXCHECK  THEN 

880  11  25:3  266  WRITEC'DATA  SEGMENT  TO  WATCH?') 

881  11  25:2  300  ELSE 

882  11  25:3  302  WRiTECTO  DIS-aSSEMBLE7«  )  ; 

883  11  25:2  330  READ(CH); 

884  11  25:2  340  IF  (CH='L»)  OR  (CH=»L»)  THEN 

885  11  25:3  349  PROCLOOK 

886  11  25:2  349  ELSE  iF  ((CH='A«)  OR  (CH=«AM)  AND  (NOT  LEXCHECK)  THEN 

887  11  25:4  366  BEGIN 

888  11  25:5  366  PAGE ( OUTPUT ) ; 

889  11  25:5  376  WRITELN ( 'DIS-ASSEMBLING  ALL* ^PROCSC 03: 3, •  PROCEDURES' fCRi CR ) ; 

890  11  25:5  478  IF  NOT  DISPLAY  THEN  WRITE(CR t CR» ' { • . SEGNUM:2» • ) • ) ; 

891  11  25:5  532  ALLPROCS; 

892  11  25:5  534  PROMPT; 

893  11  25:5  537  ch:='Q'; 

894  11  25:4  540  END 

895  11  25:3  540  ELSE  IF  (CH>='0')  AND  (CH<='9')  THEN 

896  11  25:5  551  BEgiN 

897  11  25:6  551  PROCNUM: =ORD(CH) -ORD( • 0 • ) ; 

898  11  25:6  556  READ{CH); 

899  11  25:6  566  IF  (CH>=»0')  AND  {CH<='9')  THEN 

900  11  25:7  575  PROCNUM: =PROCNUM*10  +    ORD(CH)  -  ORD(»0'); 

901  11  25:6  584  IF  (PR0CNUM<1)  OR  ( fii^CNUM>PROCSC  0  3 )  THEN 


302  11  25:7  Sn^i  BEGIN 

lol  II  IV'l  <?n  WRITL-LiM(CR.'I  DIOrj^T  SAY  YOU  HAD  THAT  PROCEDURE!') 

^UH  ii  do . 8  o70  PROMPT! 

905  11  25:7  673  END 

Int  II  iV^  ^"^^  ^^S^  ^^    •^OT  LEXCHECK  THEN 

907  11  25:8  680  BEGIN 

Int  \^  ^^'^  ^^^  PAGE(OUTPUT); 

910  11  IV'l  yla  WRITELNCDIS-ASSEMBLING  PROCEDURE »  ,PR0CNUM:3  .CR)  ; 

„rlr  ^^  ^^'^  "5^+  PROCEJUR; 


o  PROMPT 


ch:  = 


•  =  f  » 


911  11  25:9  75 

912  11  25:9  759 

913  11  25:8  762  END 
91*+  11  25:7  762          elSE 
915  11  25:8  764            BEGIN 

f:^  JJ  25:9  764  DATAPROC:=PROCNUM; 

qVo  ].  S''^  "^""^  dataseg:=segnum; 

918  11  25:9  770  DATASEGlNFO? 

Ill  JJ  25:9  772  DATASEGSIZE:=DTSGSZ5 

9P?  \\  o  ^  ^^^  NEW(DSSTaRT); 

922  11  25-9  III  FOR  IJ=1  TO  ((DATASE6SIZE+19)  DIV  20)  DO  NEW(DSSPACE)5 

923  11  ll'-l  IV.  FILLCHAR(DSSTART%DATASE6SIZE*2,0); 

III  \:  11:1  III  FOR  procnum:=i  to  procscod  do 

^<:t  II  «iO,0  840  BEGIN 

925  11  25:i  8H0  PROCEJUR; 

11%  \\  ll\l  tl^  proclexcprocnumd:=lexlevel; 

7iJ7  11  25:o  354  end; 

928  11  25:9  861  CH:=CHR{7); 

929  11  25:8  864  END; 

930  11  25:5  864        END; 

932  U  25;J  ITl    end;'''  ^'""''^  °'  ^''='''^  °'  (CH=CHR(7)); 

933  11  25:o  908 

934  11  28:D      1  PROCEDURE  SEGMTGUIDE; 

935  11  28:o    1  vAR  i,j:integer; 

936  11  28:0      0  3EGIN 

937  11  28:i      0    REPEAT 

938  11  28:2      0      PAGE(OUTPUT); 

94n  \\  ll\l  L°      WRITelN(»SEGMENT  GUIDE:   «(0F  SEGMENT) .Q(UIT) M ; 

qa?  11  ll:l  ..^  ^«/RlTELN(CR,CR.'YOU  HAVE  THESE  SEGMENTS:'); 

"^^tl  11  28.2  130  FOR    I:=0    TO    15    DO 

942  11  -!8:3  im  3E5IN  591 
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9'+3  11  23:4  141  ...RITE  (!:'+.'       •); 

^H't  11  sa:"!  ib9  FOR  J:=1  to  c*  do  ^RITE(CHR(SEGDIRECCo3  +  I*8  +  JD)); 

9^+5  11  28:4  212  .vriteln; 

946  11  28:3  220  ENJ; 

9^+7  11  28:2  227  uJRITe  ( CR  ,•  WHICH  SEGMENT  TO  LOOK  AT  •)! 

948  11  28:2  274  IF  LeXCHECK  THEM 

949  11  28:3  278  WRITECTO  DECIDE  ON  DATA  SEGMENT?') 

950  11  28:2  316  ELSE 

951  11  28:3  313  ^RlTE(»FOR  POSSIBLE  DIS-ASSEMBLY?' ) ; 

952  11  28:2  356  READ(CH); 

953  11  28:2  366  IF  (CHO'QM  AND  (CHO'QM  THEN 

954  11  28:3  375  BEGIN 

955  11  28:'+  375  SEGNUM:=0; 

956  11  28:4  378  IF  (CH>=»0')  AND  (CH<=»9»)  THEN  SEGNUM:=0RD{CH) -ORD ( • 0 • ) ; 

957  11  28:i  392  READ(CH); 

958  11  28:4  402  IF  {CH>=«0»)  AND  (CH<=«9»)  THEN 

959  11  28:5  411  SEGNUM:=SEGNUI«i*lO  +  ORD(CH)  -  QRDCO'); 

960  11  28:4  420  IF  ( SEGDIRECC4*SEGNUM3  +  SEGDIRECC4*SEGNUM  +  l3=0)  OR  {SEGNUM>15)  THEN 

961  11  28:5  455  BEGIN 

962  11  28:6  455  WRITELN(CR' '  I  DIDN"T  SAY  YOU  HAD  THAT  SEGMENTIMj 

963  11  28:6  519  READ (KEYBOARD, CH ) ; 

964  11  28:5  529  END 

965  11  28:4  529  ELSE 

966  11  28:5  531  BEGIN 

967  11  28:6  531  PROCGUIDEJ 

968  11  28:6  533  IF  CH<>CHR(7)  THEN  CH:=»A»! 

969  11  28:5  541  END; 

970  11  28:3  541  ENO; 

971  11  28:i  541  UNTIL  (CH='QM  OR  (CH=»QM  OR  (CH=CHR(7))5 

972  11  28:0  554  END5 

973  11  28:0  574 

974  11  29:0  1  PROCEDURE  LEXGUIDE; 

975  11  29:o  0  BEGIN 

976  11  29:i  0  lexcheck:=true; 

977  11  29:i  3  dataseg:=-i; 

978  11  29:i  7  REPEAT 

979  11  29:2  7  SEGMt&UIOE; 

980  11  29:2  9  IF  (CH='Q')  OR  (CH=»Q»)  THEN 

981  11  29:3  13  BE3IN 

982  11  29:4  18  PAGE < OUTPUT ) ; 

933  11  29:4  23  30T0XY ( 0 , 10 ) ; 


984 

11 

29:h 

33 

985 

11 

29:4 

103 

986 

11 

29:4 

113 

987 

11 

29:3 

130 

988 

11 

29:i 

130 

989 

11 

29  :i 

139 

990 

11 

29:2 

143 

991 

11 

29:3 

154 

992 

11 

29:4 

135 

993 

11 

29:5 

185 

99if 

11 

29:5 

187 

995 

11 

29:5 

190 

996 

11 

29:5 

192 

997 

11 

29:4 

204 

998 

11 

29:3 

204 

999 

11 

29:i 

224 

1000 

11 

29:i 

234 

1001 

11 

29:o 

237 

looa 

11 

29:o 

254 

1003 

11 

i:o 

0 

loot 

11 

i:i 

0 

IOCS 

11 

i:i 

10 

1006 

11 

i:i 

15 

1007 

11 

i:i 

86 

1006 

11 

i:i 

148 

1009 

11 

i:i 

158 

1010 

11 

i:i 

167 

1011 

11 

i:i 

178 

1012 

11 

i:i 

188 

1013 

11 

i:i 

193 

lom 

11 

i:i 

243 

1015 

11 

i:i 

253 

1016 

11 

i:i 

262 

1017 

11 

1:2 

266 

1016 

11 

1:3 

266 

1019 

11 

1:3 

276 

1020 

11 

1:3 

281 

1021 

11 

1:3 

291 

1022 

11 

1:3 

362 

1023 

11 

1:3 

403 

1024 

11 

1:4 

453 

ReJdTkEYbSard^cSm''^'^'-^  '°'''  '''''''    '^°^'  ^'^■'^  S""^^^  WATCHING?*); 

IF  (CH=»YM  OR  (CH=«Y»)  THEN  DATAWATCH:=FALSE: 
END; 

UNTIL  (CH=CHR(7))  OR  (NOT  DATAwATCH); 
IF  DATawATCH  THEN 

FOR  SEGNUM:=0  to  Ib  DO 

IF  SEGDIRECC4*sEGNUM3  +  SEG0IRECC4*SEGNUH  +  13O0  THEN 
3EGIN 

SEGMINT;  CSETS  up  APPROPIATE  SEGMENTS 
PR0CNUM:=1; 

PROCEJUR;  CSETS  UP  PROCEDURE  TO  DETERMINE  SEGMENT'S  LEXLEVELl 
SEGLEXCSEGNUM]:=LEXLEVEL5  oc«p-.civi  a  LLXLtVEL3 

END 

else  seglexcsegnum3:=100; 
pagecoutput); 
lexcheck:=false; 
end; 

BEGIN  {*  SEGMENT  DISASSEMBLE  *) 
PAGE(OUTPUT)? 
GOTOXY(OtlO); 

^^^'^^^*  00  TOU  WISH  TO  KEEP  TRACK  OF  REFERENCES' ,CR, 

READ(KEYBOARD,CH)  J°  '  '''^R^ICULAR  PROCEDURE-S  DATA  SEGMENT?'); 
DATAWATCH:=(CH=»Y')  or  (CH=»Y'); 

PAGE?o3?pIn;^^^'^  LEXGUIDE  ELSE  LEXCHECK:=FALSE; 
GOTOXY(OflO) i 

WRITECDO  YOU  WISH  CONTROL  OVER  DIS-ASSEMBLY?* )  ; 
READ(KEYaOARD,CH);  ^ciDLTf  ), 

control:=<ch='y»)  or  (ch='Y»){ 
if  control  then 

BEGIN 

PAGE(OUTPUT) ; 

GOTOXY(0.7); 

WRITE(CHR(7)); 

S^im::rp.S2^p««^^3  -,[,  ^I::J?T'"  a.^  g.th««  on  oxs-assembuo.,, 

IF  DATAWATCH  THEN  WRITELN(CR .CR, •  t, 

♦***    THIS  INCLUDES  DATA  SEGMENT  WATCHING    *»   ij   593 
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10.^5 
1026 
1027 
1028 
1029 
1030 
1031 
1032 
1033 
10314 
1035 
1036 
1037 
1038 
1039 
1039 
1040 
lOtl 
1042 
10^3 
10'+'+ 
10*+5 
10^+6 
10'+7 
lOt+S 

lo^+g 

1050 
1051 
1052 
1053 
105"+ 
1055 
1056 
1057 
1058 
1059 
1060 
1061 
1062 
1063 
106'+ 


11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 


1 
1 
1 
1; 

i; 
i; 
i: 
11 
i: 
i; 
i; 
i: 


:3 
:  3 

12 

:i 

:2 
:3 

13 

;5 

:5 

■A 

;3 
1:2 
1:0 
1 


:0 

;o 

0 

;o 

0 

:0 
:D 
:D 
;d 


2:d 
2:0 
2:1 
2:1 
2:1 
2:1 
2:1 
2:1 
2:2 
2:1 
2:2 
2:1 
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2:1 
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2:1 
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2:0 
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533 

532 

532 
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534 

559 

570 

570 

615 

643 

655 

658 

653 

674 

674 

674 

674 

674 

674 

1 

1 

42 

1 

0 

0 

3 

43 

93 
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295 

339 

404 

445 

497 

540 
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668 

684 


REAQ(KEYBOARQiCH) ; 

s£;3mtguide; 

End 

ELSE 
BEGIN 

IF  NOT  CONSOLE  THEN  WRITE ( CHR ( 12 ) tCR ) 5 
FOR  SEGNUM:=0  TO  15  DO 

dE&IN 

if  not  console  then  write ( cr • ' ( ' » segnum : 2 » • ) * ) ; 
if  segdirec!:4*segnumd  +  segdirecc4*segnum  +  13o0  then  segmint; 
enoj 

PROMPT; 

End; 
end; 
(*$i  disasmi.text  *) 

(*$I  DISASM2.TEXT*) 

CSTART  OF  DISASM2,TEXT3 
CCOPYRIGHT  (c)  REGENTS  OF  UNIVERSITY  OF  CALIFORNIA  AT  SAN  DIEGOD 

SEGMENT  PROCEDURE  GATHER; 

vAR   filename:string; 

PROCEDURE  WRITEHDR(VAR  H: INTERACTIVE ; HEADER: INTEGER) ; 
BEGIN 

CASE  HEADER  OF 

1:  WRlTELN(Ht'  PARAVIETER  ONE'); 

2;  WRITELN(H.*3ITS  USED     TOTAL     PERCENTAGE*); 

3:  WRlTELN(H»«  PARAMETER  ONE  PARAMETER  TWO  »); 

4:  WRlTELN(Hf 'BITS  USED     TOTAL     PERCENTAGE     TOTAL     PERCENTAGE*); 

5:  WRlTELN(Ht'  PARAMETER  ONE  PARAMETER  TWOS 

•  CASE  TABLE  SIZEM; 


6; 

7; 
8: 

END  I 

end; 


WRITELN{H,»BITS  USED     TOTAL 
WRlTELN(Hi 'FLAVOR       TOTAL 
WRITELN(H,'    n         TOTAL     PCT 


PERCENTAGE 

I 

PERCENTAGE 
« 

n         TOTAL 


TOTAL  PERCENTAGE' « 

TOTAL     PERCENTAGE'); 
FLAVOR', 
TOTAL     PERCENTAGE'); 

PCT    n  TOTAL' » 

PCT    n  TOTAL     PCT') 


10o5  12  3:D      1  pKOClDURE  JUMPSTUFF; 

1066  12  3:0      1  vAR    IIJnTEGER; 

1067  12  3:0      u  BEGIfNi 

In^Q  J?  l:'^  J    WRITELN(LISTFILE»CP,'JU^/1P  STATISTICS  ON  THE' ,  JUMPTOTAL:  5 ,  ♦  TOTAL  JUMPS'); 

lUb9  12  3:i     87    IF  JijMpTOTAL>0  THEN 

1070  12  3:2     93      BEGKm 

1071  12  3:3     93        WRITELN(LISTFILE«CR, 

1073  ^^l  l'*l  m  ,   ^      *  POSITIVE  JUMPS  NEGATIVE  JUMPS'); 

1073  12  3:3  176        WRlTEHQR  (LISTFILE » «+ )  ; 

107if  12  3:3  132        ;,|ITH  JUMPSTATS  DO 

1075  12  3:1  182  FOR  i:=0  TO  15  DO 

Illy  \\  X''\  OR?  WRITELN(LISTFlLE,I  +  i:5,POSCn:i3,POSi:n/JUMPTOTAL*100:m:2, 

1078  12  3:2  312      E  NEGC  ID:  9,  NEGCI  VJUMPTOTAL*100 :  ltf:2)  ; 

1080  12  3'^  '^^    ^^^^    WRITELN(LISTFILE»CR. 'SORRY  NO  JUMPS  TODAY!') ; 

1081  12  3:0  382 

1082  12  5:0      1  PROCEDURE  PROCSTUFF; 

1083  12  5:D      1  VAR    IiJ:INTEGER; 
108<+  12  5:0      0  BEGIN 

MVL  \\  V^  °    WRITELN(LISTFILE,CR. 'PROCEDURE  CALL  STATISTICS'); 

1086  12  5:i  55    FOR  i:=o  TO  15  DO 

1087  12  5:2  66      IF  PROCCALLC  I DONIL  THEN 

1088  12  5:3  80       FOR  J:=l  TO  MAXPROCNUM  DO 
inoo  W  !•**  ^^         '^^    PROCCALLCI3''[:J3>0  THEN 

1091  W  VX  \\\  WRITELNiLISTFlLE.'   SEGMENT: ',  I  :H, '   PROCEDURE:  •  ,j:«t, 

1092  12  5;o  252  end;  '   CALLS:  SPROCCALLC  n-^CJ^:** )  ; 

1093  12  5:0  274 

109tf  12  6:D      1  PROCEDURE  HISTOGRAM  ( PCTMAX:  INTEGER )  ; 

1095  12  6:D      2  VAR   I: INTEGER; 

1096  12  6:0      0  3EGIN 

JSII  ^^  ^••'-      °    PCTMAX:=ROUND(PCTMAX/MAXOP*20); 

1098  12  6:i  12    FOR  i:=i  TO  PCTMAX  DO  WRITE ( LiSTFILEt ♦*') ; 

1099  12  6:o  fO  END; 

1100  12  6:o  S't 

1101  12  7:D      1  PROCEDURE  SHORTSTUFF; 

1102  12  7:d      1  VAR   l:I,MTEGER; 

1103  12  7:D      2 

UOH  12  a:0      1  PROCEDURE  SHORTKVAR  h:  INTERACTIVE)  ; 

1105  12  8:o      0  3EGIN  595 
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1106  li  3:i  J  wRiTt(  ^,CR, 'sLi;:   opcode:  0..127   TOTftL:*, 

1107  li  8:1  43  SLDC:8,SLDC/GPTOTAL*100:16:2, '  %  •); 

1103  12  3:1  37  HISTDGraM(3LDC) ; 

1109  12  3:1  91  IF  SLDCOO  THEN 

1110  12  8:2  97  BEGIN 

1111  12  a:3  97  WRITELN(H,CR) ;  WRITEHDR ( H, 3 ) ; 

1112  12  8:3  115  FOR  OP:=0  TO  31  UO 

1113  12  a:**  126  /jriteln{h,op:4.»:»,opcodecopj^.totalo:7»opcodecop3*.totalo/sldc*ioo:7:2, 

lim  12  8:h  138  OP  +  32:'+.»:«,OPCODECOP+32D^.TOTAL0:7,GPCODECOP  +  32:'*.TOTAL0/SLDC*100:7:2, 

1115  12  8:4  256  0P  +  6'+ :  ^t .  •  :  •  ,  OPCODEC  0P  +  S4  D'" .  TOTAlO  :  7 ,  OPCODEC  0P  +  6f  3"^.  TOTAL0/SLDC*100  : 7  : 2  i 

1116  12  8:4  324  nP  +  96:4.  •  :»,opcodecop+96:'".totalo:7,opcodecop  +  96D''.totalo/sldc*ioo:7:2) 

1117  12  8:2  405  end; 

1118  12  8:i  405  WRITE(H,CR,CRi 'SLOL   OPCODE:  216. .231   TOTALI'f 

1119  12  8:i  461  sldl:8»sldl/optotal*ioo:i6:2,'  %   »); 

1120  12  8:i  500  HISTOGRAM(SLDL) ; 

1121  12  8:i  504  IF  SLDLOO  THEN 

1122  12  8:2  510  BEGlrvl 

1123  12  8:3  510  WRITELN(H,CR);  WRITEHDR (H, 8 ) 5 

1124  12  8:3  528  FOR  0P:=216  TO  219  DO 

1125  12  8:4  543  WRITELN  (  H.  0P:4»  •  :  •  i  OPCODECOPD^.TOTALO  :7iOPCODECOP3'^.TOTAL0/SLDL*100  :  7:  2, 

1126  12  8:4  605  OP+4: 4  ,  »  :  »  ,  OPCODEC  OP+4  D-^.  TOTALO  :  7  t  OPCODECOP  +  43'^,TOTALO/SLDL*100  :7:2  . 

1127  12  8:4  673  0P+8:4t  ♦  :  •  tOPCODECOP  +  S^^.TOTALO :  7»  OPCODECOP+83'',TOTAL0/SLDL*100 : 7:2» 

1128  12  8:4  741  OP+12  : 4  ,  ♦  :  •  ,  OPCODEC  OP+123'^,  TOTALO  :  7  ,  0PC0DEC0P  +  12D^.  T0TAL0/SLDL*100  : 7:  2 ) 

1129  12  8:2  822  END; 

1130  12  8:0  822  END; 

1131  12  8:o  846 

1132  12  9:D  1  PROCEDURE  SH0RT2(VAR  h:  INTERACTI\/E )  ; 

1133  12  9:o  0  BEGIN 

1134  12  9:i  0  WRITE(H,CR,CR, 'SLDO   OPCODE:  232. .247   TOTAL:', 

1135  12  9:i  56  SLDO:8,SLDO/OPTOTAL*100:i6:2»»  %    *)\ 

1136  12  9:i  95  HIST0GR(\M(SLD0)  ; 

1137  12  9:i  99  IF  SLDoOO  THEN 

1138  12  9:2  105  BEGIN 

1139  12  9:3  105  WRITELN(H.CR) ;  WRITEHDR { H, 8 ) ; 

1140  12  9:3  123  FOR  0P:=232  TO  235  DO 

1141  12  9:4  138  WRlTELN(H.OP:4t':«fOPCODECOP3'".TOTAL0:7tOPCODECOPD'',TOTAL0/SLDO*100:7:2i 

1142  12  9:4  200  OP+4  :  4  ,  •  :  •  .  OPCODEC OP  +  4 3" . TOTALO  : 7 ♦  OPC0DECOP+4D'",TOTAL0/SLDO*100  : 7: 2  . 

1143  12  9:4  268  OP+8 : 4  ,  •  :  •  »  OPCODEC  OP  +  8:*  .TOTALO  :  7,  OPCODECOP+83''.TOTAL0/SLDO*100  :  7: 2 . 

1144  12  9:4  336  OP  +  12  :  4 .  ♦  :  •  ,  OPCODEC  0O  +  12  D*^.  TOTALO  :7,  OPCODECOP  +  12  D'*.  TOTAL0/SLDO*100  :  7 : , 

1145  12  9:2  417  END; 

1146  12,  9:i  417  WRITE(H,CR,CR.'SIND   OPCO!^  248.  .  255   TOTAL:** 


1147 
1143 
1149 
1150 
1151 
1152 
1153 
1154 
1155 
1156 
1157 
1158 
1159 
1160 
1161 
1162 
1163 
1164 
1165 
1166 
1167 
1166 
1169 
1170 
1171 
1172 
1173 
1174 
1175 
1176 
1177 
1178 
1179 
1180 
1181 
1182 
1183 
1184 
1185 
1136 
1187 


12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 


9: 
9; 

9; 

9 

9; 

9: 

9: 

9; 

9; 

9: 

9: 

9; 

9: 

9; 

7; 

7; 

7: 

7; 

7; 

10; 

10; 

10; 

10; 

10; 

10; 

10; 

10: 

10 

11 

11 

11 

11 

11; 

11 

11 

11 

11 

11: 

11: 

11: 

M 


1 
1 
1 
2 
3 
3 
4 
4 
4 
4 
2 
1 
0 
0 
0 
1 
1 
0 
0 
D 
D 
0 
1 
1 
1 
1 
0 
0 
D 
D 
0 
1 
2 
3 
3 
3 
4 
5 
5 
5 
5 


473 

512 

516 

522 

522 

540 

555 

617 

685 

753 

834 

834 

340 

864 

0 

0 

5 

10 

22 

1 

1 

0 

0 

14 

57 

60 

68 

30 

1 

I 

0 

0 

13 

13 

17 

60 

66 

66 

70 

38 

102 


SIi'JD:8,SlND/OPT0TAL*l00:l6:2i  '  %  ') 


HISTOG 

IF  SIN 

8EGI 

FO 


END! 
WRITEL' 
END; 


RAM(SIND) 

doo  then 

N 

ITELN(H»C 

R  0P:=248 

WRITELN(H 

OP+2 

OP  +  4 

OP  +  6 

g  (  H  )  ; 


R);  WRITEHDR(H.8) ; 
TO  249  DO 

,op:4i»: •«opcooecop3^.totalo:7.opcodecqp3*.totalo/sind*ioo:7:2» 
:4,«:».opcodecop  +  2  3'",totalo:7»opcodecop+23*.totalo/sind*1qo:7:2» 
:4,':«»opcodecop+4d'^,total0:7iopcodecop+4d'*.total0/slnd*100:7;2t 
:4f  »  :  '«opcodecop+63'*.totalo:7»opcodecop+63'^,totalo/sind«100:7:2)  ; 


8EGIN(*  SHORTSTUFF  *) 
SHORTI(LISTFILE) ? 
SH0RT2(LISTFILE) 5 

END! 

PROCEDURE  SHORTST! 
VAR   l:liNTEGER; 
BEGIN 

inum:=opcodecopd^,totalo; 
write(listfile»inum:8,inum/optotal*ioo;i6:2.»  %   •); 

HISTOGRAM(INUM)! 
WRITELn(LISTFILE)  ; 

END! 

procedure  onest! 
var   i:integer! 

BEGIN 

with  OPCODECOPD"  00 

BEGIN 

inum:=totali! 

WRlTE(LISTFILE»INUM:8,lNU^fl/OPTOTAL*100:i6:2i *    %    *)! 
IF    TOTALIOO    THEN 
3EGIN 

HISTOGRAM(TOTALl) ! 

vJRITELN(LIST>-ILE«CR)  ! 

WRITEHDR(LISTFILE»1) !    WRITELN ( LISTFILE) ! 

WRITEH0R(LISTFlLEt2^ 


597 


39S 


1138  12  11:5  ina         for  i:=o  to  7  do 

1139  12  li:6  119                                  WHITELIJ(LISTFlLE,I  +  i:5i3YTEONElCi::i3,BYTEONElCID/TOTALl*lC0:l'^:2)  ; 

1190  12  ll:^■  192                       zi^^ 

1191  12  11:3  192        ELSE  WR I TELN ( LISTFILE ) ; 

1192  12  11:2  202      ENO! 

1193  12  11:0  202    END; 

1194  12  11:0  21fl 

1195  12  12:0      1  PROCEDURE  TWOST; 

1196  12  12:D     1  VAR   i:inte3Er; 

1197  12  12:a      0  BEGIN 

1198  12  12:1      0    WITH  OPCODECOPD'"  DC 

1199  12  12:2     13      BEGIN 

1200  12  12:3     13        WRITE(LISTFILE,TOTAL2:8,TOTAL2/OPTOTAL*100:16:2,»  %    '); 

1201  12  12:3     58        HIST0GRAM(T0TAL2) ; 

1202  12  12:3     62        WRITELN(LISTFILE»CR) ;  WRITEHDR ( LISTFILE. 3) ; 

1203  12  12:3     86        WRITELN(LISTFILE)  ;  WRITEHDR  ( LISTFILE*  tf )  ; 
I20if  12  12:3  100        IF  TOTAL2  =  0  THEN 

1205  12  12:4  106          FOR  i:=0  TO  7  DO 

1206  12  12:5  117           WRITELN(LISTFILE.I+1:5,BYTEONE2CID:13,0. 0:14:2, BYTETW02Cn:9,0.0:if:2) 

1207  12  12:3  206        ELSE 

1208  12  12:4  215         FOR  i:=Q  TO  7  DO 

1209  12  12:5  226            WRITELNtLISTFlLE. 1  +  1:5, BYTEONE2Cn:i3,BYTEONE2[:n/TOTAL2*100:i4:2, 

1210  12  12:5  284                          BYTETW02CI3:9,BYTETW02Cn/TOTAL2*100:if  :2)  ; 

1211  12  12:3  345        IF  OP=205  THEN 

1212  12  12:4  352          BEGIN 

1213  12  12:5  352            WRITELN(LISTFILE)  ;  WRITEHDR (LISTFILE,7 ) ; 

1214  12  12:5  366            IF  TOTAL2=0  THEN 

1215  12  12:6  372              FOR  i:=2  TO  15  DO 

1216  12  12:7  383                 WRITELN ( LISTFILE , NAMESC 56+1 3, FLAV0R2C I D : 9 , 0 . 0 : 14: 2 , '      •, 

1217  12  12:7  461                           NAIW|ESC56  +  I  +  14D,FLAVOR2CI  +  I43:9,0,0:m:2) 
1216  12  12:5  534            ELSE 

1219  12  12:6  543              FOR  i:=2  TO  15  DO 

1220  12  12:7  554                WRITELN(LISTFILE,NAMESC56+ID,FLAV0R2CI3:9, 

1221  12  12:7  600                          FLAVOR2CID/TOTAL2*100:l'*:2,'      '« 

1222  12  12:7  646                          NAMESC 56+1+143, FLAV0R2CI+14 D : 9 , 

1223  12  12:7  696                           FLAV0R2C  I  +  lf  3/TOTAL2*100 :  1*+ :  2 )  ; 

1224  12  12:4  742          END; 

1225  12  12:2  742      END! 

1226  12  12:0  742  END; 

1227  12  12:0  774 

1223  12  13:D      1  PROCEDURE  ^OROST; 


1229 

12 

13  :d 

A. 

1230 

12 

13  :o 

0 

1231 

12 

13  ;i 

0 

1232 

12 

13:2 

13 

1233 

12 

13:3 

13 

123'* 

12 

13:3 

17 

1235 

12 

13:3 

60 

1236 

12 

13:4 

66 

1237 

12 

13:5 

66 

1238 

12 

13:5 

70 

1239 

12 

13:5 

94 

1240 

12 

13:5 

108 

12^+1 

12 

13:6 

119 

12'+2 

12 

13:4 

192 

12'f3 

12 

13:3 

192 

124*+ 

12 

13:2 

202 

1245 

12 

i3:o 

202 

1246 

12 

i3:o 

218 

1247 

12 

14  :d 

1 

1248 

12 

14:d 

1 

1249 

12 

i4:o 

0 

1250 

12 

14:i 

0 

1251 

12 

14:2 

13 

1252 

12 

14:3 

13 

1253 

12 

14:3 

17 

1254 

12 

14:3 

60 

1255 

12 

14:4 

66 

1256 

12 

14:5 

66 

1257 

12 

14:5 

70 

1258 

12 

14:5 

94 

1259 

12 

14:5 

108 

1260 

12 

14:6 

119 

1261 

12 

14:6 

177 

1262 

12 

14:5 

238 

1263 

12 

14:6 

249 

1264 

12 

14:4 

322 

1265 

12 

14:3 

322 

1266 

12 

14:2 

332 

1267 

12 

i4:o 

332 

1268 

12 

i4:o 

350 

1269 

12 

r5:D 

1 

\/AR       i:  integer; 

BEGIN 

jJITH  OPCODc.TOP]'^  00 
BEGIN 

lNUNi:=T0TAL3; 

WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2.'    %    '); 
IF    T0TAL3O0    THEN 
3EGIN 

HIST0GRAM(T0TAL3) ; 

WRITELN(LISTFILE»CR) ;    WRITEHDR (LiSTFlLEt 1 ) ; 

WRITEL!y|(LlSTFILE)  ;    WRITEHDR  (LISTFILE»2)  ; 

FOR    i:=0    TO    15    DO 

WRITELN(LlSTFILE»I+l:5.PARMONE3CID:i3.PARMONE3CI3/TOTAL3*l00:i4:2)i 

END 

else  writeln(listfile); 
end; 

END? 

PROCEDURE  L0PTST5 

VAR   i:integer; 

BEGIN 

WITH  0PC0DEC0P3'*  DO 
BEGIN 

INum:=T0TAL4; 

WRlTE(LISTFILE,INUM:8,lNUM/OPTOTAL*100:i6:2t»    %    '); 
IF    T0TAL4O0    THEN 

BEGIN 

HIST0GRAM(T0TAL4) ; 

WRITELN(LISTFILE»CR) ;  WRITEHDR(LlSTFILEt 3) ; 
WRITELNiLlsTFlLE) 5  WRITEHDR (LISTFILE»4) ; 
FOR  i:=0  TO  7  DO 

WRITELN(LlSTFILE.I+i:5tBYTEONE4CI3:i3fBYTEONE4Ci:/TOTAL4*100:i4:2, 
PARMTW04CI3:9»PAR»1TW04CI3/TOTAL4*100:14:2)  ; 
FOR  i:=8  TO  15  00 

WRITELN(LlSTFILE»I+i:5fPARMTW04CID:36.PARMTW04CI3/TOTAL4*lOO:l4:2) i 

END 

else  writeln(listfile) ; 

end; 
end; 


PROCEDURE  WORDSST; 


399 


GOO 


127u 

12 

15:j 

1 

1271 

12 

i5:o 

0 

1272 

12 

i5:i 

a 

1273 

12 

15:2 

13 

1274 

12 

15:3 

13 

1275 

12 

15:3 

17 

1276 

12 

15:3 

60 

1277 

12 

15:4 

66 

1278 

12 

15:5 

66 

1279 

12 

15:5 

70 

1280 

12 

15:5 

94 

1281 

12 

15:5 

108 

1232 

12 

15:6 

119 

1283 

12 

15:6 

177 

128*f 

12 

15:6 

223 

1285 

12 

15:4 

284 

1286 

12 

15:3 

284 

1287 

12 

15:2 

294 

1288 

12 

i5:o 

294 

1289 

12 

i5:o 

312 

1290 

12 

16:d 

1 

1291 

12 

16:d 

1 

1292 

12 

i6:o 

0 

1293 

12 

i6:i 

0 

1294 

12 

16:2 

13 

1295 

12 

16:3 

13 

1296 

12 

16:3 

58 

1297 

12 

16:3 

62 

1298 

12 

16:3 

36 

1299 

12 

16:4 

92 

1300 

12 

16:5 

92 

1301 

12 

16:6 

103 

1302 

12 

16:6 

179 

1303 

12 

16:5 

255 

130'+ 

12 

16:4 

320 

1305 

12 

16:3 

320 

1306 

12 

16:4 

322 

1307 

12 

16:5 

322 

1308 

12 

16:6 

333 

1309 

12 

16:6 

377 

1310 

12 

16:6 

404 

vAR       I :  integer; 

BEGIN 

WITH    OpcODlCOPD'^    do 
BEGlxi 

INUW!:=T0TAL5; 

w,'Rite(listfile,inum:8,inum/optotal*ioo:i6:2»  •  %   M; 

IF  T0TAL5O0  THEN 
3ESIN 

HIST0GRAM(T0TAL5) ; 

WRITELN(LISTFILE»CR) ;  WRITEHDR ( LlSTFILE» 5) ; 
WRITELN(LISTFILE);  WRITEHDR ( LISTFILE.6) 5 
FOR  i:=0  TO  15  00 

writeln(listfile»i+1:5»parmone5ci3:13.parmone5ci3/total5*100:14:2. 
parmtw05ci3:9,parmtw05cid/total5*100:14:2, 
parmthree5ci3:9,parmthree5ci3/total5*xoo:14:2); 

eno 

ELSE  WRITELN(LISTFILE) ; 

end; 
end; 

PROCEDURE  CMPRSSST; 

VAR   i:integer; 

BEGIN 

WITH  OPCODECOPJ'^  DO 
BEGIN 

WRITE(LISTFILE.TOTAL6:8,TOTAL6/OPTOTAL*100:16:2»'  %    ♦); 
HlST0GRAM(T0TAL6) i 

WRlTELN(LlSTFlLEtCR) ;  WRITEHDR ( LISTFILE i 7 ) ; 
IF  TOTAL6=0  THEN 
BEGIN 

FOR  l:=0  TO  19  DO 

WRITELN(LISTFILE.NA^ESC86+I3,FLAVOR6CI3:9»0,0:14:2,»  •, 

l\lAMESC106+I3»FLAVOR6CI  +  20::9,0.0:i't:2)  ; 

WRITELN(  LISTFILE  tNARESC126::44,FLAV0R6C'+0D:  9.0.0: 14:  2)  ; 

END 

ELSE 
3EGIN 

FOR    i:=0    TO    19    DO 

WRITELN<LISTFILE.NAMESC86+ID,FLAV0R6CID:9, 
FLAVOR6[:lD/TOTAL6*100:i4:2t 
NAMESC  106  +  1  3: 3l«lfLA\/OR6C  1  +  20  :i:9.FLAV0R6C  1+20  :/T0TAL6*l00<<H^:2)  ; 


1311 
1312 
1313 

13m 

1315 

1316 

1317 

1318 

1319 

1320 

1321 

1322 

1323 

132H 

1325 

1326 

1327 

1328 

1329 

1330 

1331 

1332 

1333 

I33tf 

1335 

1336 

1337 

1338 

1339 

1340 

13m 

13'+2 

1343 

1341+ 

1345 

1346 

1347 

1348 

1349 

1350 

1351 


12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 


1&: 
16: 
16; 
16; 
16; 
16: 

17! 

17; 
17: 
17: 
17: 
17; 

17! 
17! 


17:3 
17:3 
17:4 
17:5 
17:6 
17:5 
17:6 
17:5 
17:4 
17:2 
i7:o 
i7:o 
18:d 
i8:o 
I8:i 
i8:i 
18:2 
18:3 
18:3 
18:3 


18, 

18: 
18: 
18; 
18; 

la; 

ra; 


494 

517 

571 

571 

371 

596 

1 

1 

0 

U 

13 

13 

17 

60 

64 

88 

99 

99 

104 

195 

197 

275 

290 

297 

297 

314 

1 

0 

0 

3 

18 

31 

46 

56 

70 

82 

94 

106 

118 

124 

165 


WKITELrj(LlSTFILE.^iAMESCl2&D:44, 

flavor6C4o::9,fla\/or6i:40d/total6*ioo:i4:2)  ; 


end; 


end; 
end; 

procedure  CMPRSS2ST; 
VAR    I:I^^)TEGER; 
BEGIN 

WITH  0PC0DEC0P3''  DO 
BEGIN 

INUM:=T0TAL7; 

WRlTE(LlSTFlLEf  lNUM:8tINUM/3PTOTAL*l00:i6:2»»  SB  »)? 
HISTogRAM(TOTAL7) ; 

WRITELN(LISTFILE,CR) ;  WRITEHDR ( LISTFILE»7) ; 
FOR  i:=l  TO  6  DO 
BEGIN 

IF  INUMOO  THEN 

WRITE(LISTFlLE,i\|ARESC5l  +  i:,FLAVQR7Ci::9»FLAVOR7Cn/INUM*100:i4:2«» 
ELSE 


») 


WRITE{LISTFlLEfNAMESC5l+i:,FLAVOR7CI3:9»0,0:l4:2f • 
IF  (I  MOD  2=0)  THEN  WRITELN( LISTFILE) ; 

END; 
END; 

end; 

PROCEDURE  GINIT; 
BEGIN 

MAXop:=o; 

FOR  0P:=128  TO  215  DO 
WITH  OPCODECOPD'^  DO 
CASE  RECTYPESCOPJ  OF 
ONEtCHRS,BLK:iF 
TWO:iF 
^OROfOPT:iF 

lopt:if 

wiORDS:iF 

CMPRSS:IF 

CMPRSS2:iF 


(  )  : 


) 


(T0TAU1>MAX0P)  THEN  MAX0P:=T0TAL1 ; 

{T0TAL2>MAX0P)  THEN  MAXOP:=TOTAL25 

(T0TAL3>MAX0P)  THEN  MAXOP:=TOTAL3 ; 

<T0TAL4>MAX0P)  THEN  MAX0P:=T0TAL4 ; 

(T0TAL5>MAX0P)  THEN  MAX0P:=T0TAL5 ; 

<T0TAL6>MAX0P)  THEN  MAX0P:=T0TAL6; 

(T0TAL7>MAX0P)  THEN  MAX0P:=T0TAL7 


EfMo; 


END: 


GOl 


r^  ,">  .--* 


1352  12  13:3  162 

13b3  12  l:U      0  ^EGIN  (♦  SEG'-IENT  PROCEDURE  GATHER  *) 

1354  12  i:i    0   ginit; 

1353  12  i:i      2    PAGE(OJTPUT)  ; 

1356  12  l:i  12    GOTOXY{0»10)  ; 

1357  12  i:i  17    WRITE(CriR(7) , 'OUTPUT  FILE  FOR  OPCODE  STATISTICS  (<CR>  FOR  NONE):  •); 

1358  12  i:i  90    READLN(FILENAME) ; 

1359  12  i:i  109    OISPLAy:=(FILENAME<>' • ) ; 

1360  12  i:i  118    CONS0LE:  =  {FILENAMEr:'C0NSOLE:  •  )  OR  {FILEf\iAME=*«l :  '  )  ; 

1361  12  i:i  146    IF  DISPLAY  THEN 

1362  12  1:2  149      BEGIN 

1363  12  1:3  149        IF  (  FILENAMEOLASTFILENAME  )  THEN 

1364  12  1:4  158          3EGIN 

1365  12  1:5  158           CLOSE(LISTFII-E.LOCK)  ; 

1366  12  1:5  167            REWRITE(LlSTFILEtFILENAME); 

1367  12  i:5  179        lastfilename:=filename ; 

1368  12  1:4  186         end; 

1369  12  i;3  166        PAGE(OUTPUT) 5 

1370  12  1:3  196        PROCSTUFF; 

1371  12  1:3  198        JUMPSTUFF; 

1372  12  1:3  200        SHorTSTUFF; 

1373  12  1:3  202       for  0P:=128  TO  215  DO 

1374  12  i:4  218          BEGIN 

1375  12  i;5  218           WRITE  (  LISTFII-E,CR.NAMESC0P3»  '   OPCODE: »  1  OP:  4» »    TOTAL:*); 

1376  12  1:5  303        case  rectypescopd  of 

1377  12  1:5  318                short:shortst; 

1378  12  1:5  322                     OpT» WORD: WORDST ; 

1379  12  1:5  326                 ONE, CHRS t BLK :ONEST 5 

1380  12  1:5  330                           TWO:TWOST; 

1381  12  1:5  334                         LOPTzLOPTST; 

1382  12  1:5  338                        W0RDS:W0RDSST; 

1383  12  1:5  342                       CMPRSS :CMPRSSST ; 

1384  12  i:5  346                      CMPRSS2 : CMPRSS2ST 

1385  12  1:5  346              END; 

1386  12  1:4  380          end; 

1387  12  1:3  387        WRITELN (LiSTFlLEt CR, CR «CR« OPTOTAL: 20 ♦ •    TOTAL  OPERATORS'); 
1383  12  1:3  466        WRi TELN ( CR . CR« CR ' OPTOTAL : 20 1 •    TOTAL  OPERATORS' ) ; 

1389  12  1:2  545      END; 

1390  12  1:0  545  end; 

1391  12  1:0  564 

1392  12  1:D      1  SEGMENT  PROCEDURE  DATACOUNT 


133  5 

13 

1 

:  J 

I 

rrpE 

ACTPTR  =  ''ACTREC; 

1394 

13 

1 

:ij 

1 

actrec=recoro 

1335 

13 

1 

:d 

1 

OFFSET, total: integer; 

1396 

13 

1 

:ij 

1 

les,gtr:actptr 

1397 

13 

1 

:d 

1 

END; 

1398 

13 

1 

:o 

1 

VAR 

total:integer; 

1399 

13 

1 

:d 

2 

heap:"integer; 

1400 

13 

1 

:d 

3 

treetrjnk, entry: AC tptr; 

It+Ol 

13 

1 

:d 

5 

filename:string; 

it+oa 
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1 

;d 

46 

1103 

13 

2 

:d 

1 

procedure:  setorder; 

ItOI 

13 

2 

:d 

1 

VAR 

inoex:Integer; 

l'+05 
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:o 
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:d 

1 

PROCEDURE  dataset(Treemark:actptr) ; 

1407 
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3 

!0 

0 

BEGIN 

1408 

13 

3 

:o 

0 

C$R-3 

1409 

13 

3 

:i 

0 

IF 

dsstaRT'*cindex3<treemark'^, total  then 

1410 

13 

3 

:2 

12 

IF  treemark'^.lesonil  then 

1411 

13 

3 

:3 

18 

DAtASET(TREEMARK'^.LES) 

1412 

13 

3 

:2 

20 

else 

1413 

13 

3 

53 

24 

begin 

1414 

13 

3 

:4 

24 

new(entry); 

1415 

13 

3 

:4 

30 

entry'^.offset:=index! 

1416 

13 

3 

:4 

39 

entry^. TOTAL  :=dsstart'^c  index  3; 

1417 

13 

3 

:4 

50 

ENTRY*. LES:=NIL; 

1418 

13 

3 

54 

57 

entry'^.gtr:=nil; 

1419 

13 

3 

:4 

64 

treemark'^.les:=e:ntry; 

1420 

13 

3 

:3 

71 

END 

1421 

13 

3 

;i 

71 

ELSE  IF  TREEMARK'^.GTRONIL  THEN 

1422 

13 

3 

:3 

79 

DAtASET(TREEMARK'*.GTR) 

1423 

13 

3 

:2 

81 

else 

1424 

13 

3 

:3 

85 

BEGIN 

1425 

13 

3 

;4 

85 

NEW(ENTRY) 5 

1426 

13 

3 

:4 

91 

entry'*.offset:=index; 

1427 

13 

3 

:4 

100 

ENTR  Y-^.  TOTAL  :=DSSTART^i:  INDEX  a; 

1428 

13 

3 

14 

111 

ENTRY". LES:=NIL; 

1429 

13 

3; 

4 

118 

ENTRY'*. GTR:=NIL; 

1430 

13 

3. 

4 

125 

treemark'*,gtr:=entry; 
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13 

3! 

3 

132 

END; 

1432 

13 

3: 

3 
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END; 
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1442 
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31 

1443 
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31 

1444 

13 
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53 

1445 
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1446 

13 

2:4 

62 

1447 

13 
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67 

1448 

13 

2:4 

77 

1449 

13 

2:3 

83 

1450 

13 

2:3 

83 

1451 

13 

2:1 

83 

1452 

13 

2:0 

89 

1453 

13 

2:0 

104 

1454 

13 

4:d 

1 

1455 

13 

4:d 
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1456 

13 

4:0 
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1457 

13 

4:1 
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1458 

13 

4:1 

85 

1459 

13 

4:1 

143 

1460 
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4:1 

181 

1461 

13 

4:1 

223 

1462 

13 

4:1 

260 

1463 

13 

4:0 

302 

1464 

13 

4:0 

316 

1465 

13 
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1 

1466 

13 

5:0 

0 

1467 

13 

5:1 

0 

1468 

13 

5:1 

10 

1469 

13 

5:1 

15 

1470 

13 

5:2 

18 

1471 

13 

5:1 

69 

1472 

13 

5:0 

79 

1473 

13 

5:0 

92 

1474 

lA 

1:0 

0 

3  EG  in 

NEWdREETRUNK)  ; 

treetrunk''.total:=o; 
treetrl)nk'^.les:=nil; 
treetrunk'*.gtr:=nil; 
dataref:=o;  index:=os 
repeat 
csr-j 

lNOEx:  =  IfMDEX    +    SCAN((DATASEGSIZE-INDEX)*2i<>CHR(0)  »DSSTART''i:iNDEX:i)    DIV    2; 
IF    DSSTART'^CINDEx3>0    THEN 
BEGIN 

qataset(treetrunk); 
dataref:=datare:f  +  dsstart'^cindexdj 
osstart'"CINdex3:=o; 

end; 
C$R  +  3 

UNTIL  index>=datasegsize; 

end; 

procedure  DATAHEADER(VAR  H2: INTERACTIVE); 

var  I J  integer; 

BEGIN 

writeln(h2,crfcrt»data  segment  size: • .datasegsize:6t *     data  references:', 

dataref:6f»     lex  level » ,pr0clexcdatapr0c3:6) ; 
write(h2tcr,cr,»f0r  segment  •); 

for  i:=i  to  8  do  write{h2»chr(segdirecc63  +  dataseg*8  +13)); 
writeln(h2,»  procedure  #• .dataproc : 3) ; 
writeln(h2»»0ffset(w0rd)  total     %•); 
end; 

PROCEDURE  printdata(tree:actptr) ; 

BEGIN 

IF  TREE'^.GTRONIL  then  PRINTDATA(TREE'^,GTR); 

total:=tree^. total; 

if  display  then  writeln (listfile t 

tree'".offset:9.total:ii,total/dataref*ioo:9:2)  ; 

IF  TREE'^.LESONIL  then  PRINTDATA(TREE'*.LES)  ; 

end; 

BEGIN  (*  dATACOUNT  *) ; 


If75  13  1:1  0    MARK(HrAP); 

1476  13  1:1  4    PAGE(OJTPUT) ; 

lf77  13  l;i  IH    GOTOXY(O.IO) ; 

l.M  13  III  I'          ««JJ^^CHR.7,..0UTPUT  FIU.  FOR  DAT«  ^ 

I'+SO  13  1:1  116    DISPLAy:  =  {FILENAME<>"  )  ; 

i'+3i  13  1:1  125   console:  =  (filename='Console:m  or  (FIlename=»»i:m- 

1^+82  13  1:1  153    IF  DISPLAY  AND  (  FIlENAMEOLASTFIlENAME  )  THEN 

1'433  13  1:2  164      3EGI;J 

1434  13  1:3  164        CLOSE(LISTFILE,LOCK); 

1465  lo  1:3  173        RE^RITECLISTFILE. FILENAME); 

1436  13  1:3  135      lastfilename:=filename; 

1487  13  1:2  192      end; 

1468  13  1:1  192    PAGE(OUTPUT) ; 

1459  13  1:1  2Q2    SETORDER; 

1490  13  1:1  204    IF  DISPLAY  THEN  DATAHEADER ( LiSTFlLE ) ; 

1491  13  1:1  212    IF  DATAREF>0  THEN 

1492  13  1:2  2ld  PRINTDATA(TREETRUNK'^,GTR) 

1493  13  1:1  220    ELSE 

1494  13  1:2  224  BEGIN 

1495  13  1:3  224  IF  DISPLAY  THEN  WRITELN ( LISTFILE t CR , CR , 

^aQ^  ^l  ^''^  ^'^'^                                              'SORRY  BUT  THERE  WERE  NO  ACCESSES'* 

1496  13  lit  III  end;         *  "^^  ^^^^  ^^'^'^    SEGMENT  FROM  DIS-ASSEMBLED  PROCEDURES'); 

1499  13  1:1  362    PROMPT; 

1500  13  i;i  365    RELEASl(HEAP) ; 
1301  13  1:0  369  END; 

1502  13  1:0  366 

1503  1  2:d  1  PROCEDURE  PROWPT; 

1504  1  2:d  1  vAR  ch:char; 

1505    1  2:0  0  BEGIN 

150S    1  2:1  0    WRITE(CHR(7),CR,CR, 'PRESS  SPACEBAR  TO  CONTINUE...')! 

^507    1  2:1  71    REPEAT   READ(CH)   UNTIL  CH='  '; 

1503  1  2:1  66    WRITELJ; 

150  9  1  2:i)  94  zhDi 

151J  1  2:;}  108 

1511  1  ^:3  103  (*$I  DISASi^l2,TEXT*) 

1 3 1 2  i  2 :  l;  1 '.  3 

1513  1  1:0  0  i-iEGIN(*MAXN  STUFF*) 

1514  1  1:1  rj    INIT; 

1515  1  ji:i  ^:)       disass::>i3ll;                                                305 


o 


OB 


1516 

1 

i:i 

lbi7 

1 

i:i 

1516 

1 

i:i 

1519 

1 

i:o 

32    IF  DATa.-.ATCH  TMLU  DmTACQUNT; 

■49    GATHER; 

^+2    IF  (LASTFlLtlNAMEO' •  )  AND  MOT  CONSOLE  THEN  CLOSE  {  LISTFILE  .  LOCK  ) 

6  5  e:  N  D  . 


